home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Applications / NIH Image 1.60 / 1.60 Source / Macros1.p < prev    next >
Encoding:
Text File  |  1996-03-11  |  130.2 KB  |  5,933 lines  |  [TEXT/PJMM]

  1. unit Macros1;
  2. {Contains the recursive descent parser/interpreter}
  3. {for NIH Image's Pascal-like macro language.}
  4.  
  5. {References:}
  6. {  "Pascal User Manual and Report", Kathleen Jensen and Niklaus Wirth, Springer-Verlag}
  7. {  "Building Your Own C Interpreter", Dr. Dobb's Journal, August 1989}
  8.  
  9. interface
  10.  
  11.     uses
  12.         Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, 
  13.         Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows, OSUtils,
  14.         Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
  15.         Folders, ColorPicker,
  16.         Globals, Utilities, RealUtils, Graphics, Edit, Dialogs, Files, Windows,
  17.         Analysis, Camera, File1, File2, Filters, Macros2, Stacks, Lut, Background,
  18.         User, Devices, Serial, PlugIns, Text, projection, math, fft;
  19.  
  20.  
  21.     procedure RunMacro (nMacro: integer);
  22.     procedure RunKeyMacro (ch: char; KeyCode: integer);
  23.     procedure CloseSerialPorts;
  24.  
  25.  
  26. implementation
  27.  
  28.     const
  29.         EndExpected = '"end" or ";" expected';
  30.         ThenExpected = '"then" expected';
  31.         DivideByZero = 'Divide by zero';
  32.         DoExpected = '"do" expected';
  33.         UntilExpected = '"until" expected';
  34.         RightParenExpected = '")" expected';
  35.         NoImageOpen = 'No Image open';
  36.         MaxArgs = 25;
  37.         MaxLoopCount = 20;
  38.         
  39.     var
  40.         nSaves, ErrorPC, LineStartPC: integer;
  41.         SaveBackground: integer;
  42.         SavePicWidth, SavePicHeight: LongInt;
  43.         SaveMethod: rsMethodType;
  44.         SaveCreate, SaveInvertY, SaveScaleArithmetic, SaveScaleConvolutions: boolean;
  45.         SaveCurrentFontID, SaveCurrentSize, SaveTextJust: integer;
  46.         SaveCurrentStyle: Style;
  47.         SaveTextBack: TextBackType;
  48.         SaveAngle, SaveH, SaveV: extended;
  49.         DoOption, MacroOpPending, StringsAllocated, InPhotoMode: boolean;
  50.         RoutinesCalled: set of CommandType;
  51.         MacroTicks: LongInt;
  52.         LoopCounter: LongInt;
  53.     
  54.  
  55.  
  56.     procedure test;
  57.     var
  58.       op:TokenTypeX;
  59.     begin
  60.         op:=token;
  61.     end;
  62.  
  63.  
  64.     function GetExpression: extended;
  65.     forward;
  66.     function GetBooleanExpression: extended;
  67.     forward;
  68.     procedure DoStatement;
  69.     forward;
  70.     procedure SkipStatement;
  71.     forward;
  72.     procedure DoFor;
  73.     forward;
  74.     procedure MacroError (str: str255);
  75.     forward;
  76.     function GetString: str255;
  77.     forward;
  78.     function GetInteger: LongInt;
  79.     forward;
  80.     procedure SkipIf;
  81.     forward;
  82.     procedure SkipPartialStatement;
  83.     forward;
  84.     procedure DoUserFunction;
  85.     forward;
  86.  
  87.  
  88. {$S MacroUtil}
  89. {Routines from here to the $S compiler directive go in the MacroUtil segment}
  90.  
  91.  
  92.     
  93.     
  94.     procedure PutTokenBack;
  95.     begin
  96.         if token <> DoneT then begin
  97.                 pc := SavePC;
  98.                 token := SaveToken;
  99.             end;
  100.     end;
  101.  
  102.  
  103.     procedure DeallocateStrings (first, last: integer);
  104.         var
  105.             i: integer;
  106.     begin
  107.         with MacrosP^ do begin
  108.                 for i := first to last do begin
  109.                         if Stack[i].StringH <> nil then begin
  110.                                 DisposeHandle(handle(Stack[i].StringH));
  111.                                 Stack[i].StringH := nil;
  112.                             end;
  113.                     end;
  114.             end;
  115.     end;
  116.  
  117.  
  118.     procedure TrimString (var str: str255);
  119.     begin
  120.         if length(str) > 0 then begin
  121.                 while (length(str) > 1) and (str[1] = ' ') do
  122.                     delete(str, 1, 1);
  123.                 while (length(str) > 1) and ((str[length(str)] = ' ') or (str[length(str)] = ';')) do
  124.                     delete(str, length(str), 1);
  125.             end;
  126.     end;
  127.  
  128.  
  129.     procedure LookupVariable;
  130.         var
  131.             VarFound: boolean;
  132.             i: integer;
  133.     begin
  134.         with MacrosP^ do begin
  135.                 VarFound := false;
  136.                 i := TopOfStack + 1;
  137.                 repeat
  138.                     i := i - 1;
  139.                     VarFound := SymbolTableLoc = Stack[i].SymbolTableIndex
  140.                 until VarFound or (i = 1);
  141.                 if VarFound then
  142.                     with stack[i] do begin
  143.                             TokenValue := value;
  144.                             if vType <> StringVar then
  145.                                 token := Variable
  146.                             else begin
  147.                                     token := StringVariable;
  148.                                     if StringH <> nil then
  149.                                         TokenStr := StringH^^
  150.                                     else
  151.                                         TokenStr := 'Deallocated String';
  152.                                 end;
  153.                             TokenStackLoc := i;
  154.                         end;
  155.             end; {with}
  156.     end;
  157.  
  158.  
  159.     function FetchInteger: integer;
  160.         var
  161.             temp: integer;
  162.     begin
  163.         with macrosP^ do begin
  164.                 temp := ord(macros[pc]);
  165.                 pc := pc + 1;
  166.                 FetchInteger := bor(bsl(temp, 8),  ord(macros[pc]));
  167.                 pc := pc + 1;
  168.             end;
  169.     end;
  170.  
  171.  
  172.     procedure LookupProcedureOrFunction;
  173.     begin
  174.         with MacrosP^ do begin
  175.                 SymbolTableLoc := FetchInteger;
  176.                 with SymbolTable[SymbolTableLoc] do begin
  177.                         TokenLoc := loc;
  178.                         TokenSymbol := symbol;
  179.                     end;
  180.             end;
  181.     end;
  182.  
  183.  
  184. function FetchReal: real;
  185.         type
  186.             bytes=packed array[1..4] of char;
  187.         var
  188.             vrec:record
  189.                 case integer of
  190.                     1: (rv: real);
  191.                     2: (b: bytes)
  192.                 end;
  193.     begin
  194.         with macrosP^,vrec do begin
  195.             b[1] := macros[pc];
  196.             pc := pc + 1;
  197.             b[2] := macros[pc];
  198.             pc := pc + 1;
  199.             b[3] := macros[pc];
  200.             pc := pc + 1;
  201.             b[4] := macros[pc];
  202.             pc := pc + 1;
  203.             FetchReal:=rv;
  204.         end;
  205.     end;
  206.  
  207.  
  208.     procedure GetToken;
  209.     begin
  210.         with MacrosP^ do begin
  211.                 if token = DoneT then
  212.                     exit(GetToken);
  213.                 SavePC := PC;
  214.                 SaveToken := token;
  215.                 token := TokenTypeX(ord(macros[pc]));
  216.                 while token = NewLineT do begin
  217.                         MacroLineNumber := MacroLineNumber + 1;
  218.                         pc := pc + 1;
  219.                         LineStartPC := pc;
  220.                         if pc > EndMacros then begin
  221.                                 Token := DoneT;
  222.                                 exit(GetToken);
  223.                             end;
  224.                         SavePC := PC;
  225.                         SaveToken := token;
  226.                         token := TokenTypeX(band(ord(macros[pc]),255));
  227.                     end;
  228.                 pc := pc + 1;
  229.                 if pc > EndMacros then begin
  230.                         Token := DoneT;
  231.                         exit(GetToken);
  232.                     end;
  233.                 case token of
  234.                     CommandT, FunctionT, StringFunctionT, ArrayT:
  235.                         begin
  236.                             MacroCommand := CommandType(ord(macros[pc]));
  237.                             pc := pc + 1;
  238.                         end;
  239.                     Identifier:  begin
  240.                             SymbolTableLoc := FetchInteger;
  241.                             if TopOfStack > 0 then
  242.                                 LookupVariable;
  243.                         end;
  244.                     ProcedureT, UserFunctionT: 
  245.                         LookupProcedureOrFunction;
  246.                     NumericLiteral: 
  247.                         TokenValue := FetchReal;
  248.                     StringLiteral:  begin
  249.                             TokenStr := '';
  250.                             while ord(macros[pc]) <> 0 do begin
  251.                                     TokenStr := Concat(TokenStr, macros[pc]);
  252.                                     pc := pc + 1;
  253.                                 end;
  254.                             pc := pc + 1;
  255.                         end;
  256.                 end; {case}
  257.             end; {with}
  258.     end;
  259.  
  260.  
  261.     procedure GetMacroName;
  262.         var
  263.             i, len: integer;
  264.     begin
  265.         with MacrosP^ do begin
  266.                 pc := PCStart;
  267.                 repeat
  268.                     pc := pc - 1;
  269.                     if pc < 0 then
  270.                         exit(GetMacroName);
  271.                 until macros[pc] = chr(ord(MacroT));
  272.                 GetToken; {MacroT}
  273.                 GetToken; {Macro name}
  274.                 if Token = StringLiteral then begin
  275.                         len := length(TokenStr);
  276.                         if len > SymbolSize then
  277.                             len := SymbolSize;
  278.                         for i := 1 to len do
  279.                             MacroOrProcName[i] := TokenStr[i];
  280.                     end;
  281.             end;
  282.     end;
  283.  
  284.  
  285.     procedure ConvertTokenToString (var str: str255);
  286.         var
  287.             i, j, len: integer;
  288.     begin
  289.         with MacrosP^ do
  290.             case token of
  291.                 semicolon: 
  292.                     str := ';';
  293.                 comma: 
  294.                     str := ',';
  295.                 colon: 
  296.                     str := ':';
  297.                 LeftParen: 
  298.                     str := '(';
  299.                 RightParen: 
  300.                     str := ')';
  301.                 LeftBracket: 
  302.                     str := '[';
  303.                 RightBracket: 
  304.                     str := ']';
  305.                 PlusOp: 
  306.                     str := '+';
  307.                 MinusOp: 
  308.                     str := '-';
  309.                 MulOp: 
  310.                     str := '*';
  311.                 DivOp: 
  312.                     str := '/';
  313.                 eqOp: 
  314.                     str := '=';
  315.                 ltOp: 
  316.                     str := '<';
  317.                 gtOp: 
  318.                     str := '>';
  319.                 neOp: 
  320.                     str := '<>';
  321.                 leOp: 
  322.                     str := '<=';
  323.                 geOp: 
  324.                     str := '>=';
  325.                 orOp: 
  326.                     str := 'or';
  327.                 IntDivOp: 
  328.                     str := 'div';
  329.                 modOp: 
  330.                     str := 'mod';
  331.                 andOp: 
  332.                     str := 'and';
  333.                 NotOp: 
  334.                     str := 'not';
  335.                 AssignOp: 
  336.                     str := ':=';
  337.                 Identifier, Variable, StringVariable, ProcIdT, UserFuncIdT:  begin
  338.                         for i := 1 to SymbolSize do
  339.                             str := Concat(str, SymbolTable[SymbolTableLoc].symbol[i]);
  340.                         TrimString(str);
  341.                     end;
  342.                 NumericLiteral:  begin
  343.                         if trunc(TokenValue) = TokenValue then
  344.                             RealToString(TokenValue, 1, 0, str)
  345.                         else
  346.                             RealToString(TokenValue, 1, 1, str);
  347.                     end;
  348.                 StringLiteral: 
  349.                     str := concat('''', TokenStr, '''');
  350.                 CommandT, FunctionT, StringFunctionT, ArrayT, UserFunctionT: 
  351.                     for i := 1 to nSymbols do begin
  352.                             with SymbolTable[i] do
  353.                                 if (tType = token) and (MacroCommand = cType) then begin
  354.                                         for j := 1 to SymbolSize do
  355.                                             str := Concat(str, symbol[j]);
  356.                                         TrimString(str);
  357.                                     end;
  358.                         end; {for}
  359.                 otherwise
  360.                     for i := 1 to nSymbols do begin
  361.                             with SymbolTable[i] do
  362.                                 if tType = token then begin
  363.                                         for j := 1 to SymbolSize do
  364.                                             str := Concat(str, symbol[j]);
  365.                                         TrimString(str);
  366.                                     end;
  367.                         end; {for}
  368.             end; {case}
  369.     end;
  370.  
  371.  
  372.     procedure GetErrorLine (var ErrorLine: str255);
  373.         var
  374.             str: str255;
  375.     begin
  376.         with MacrosP^ do begin
  377.                 pc := LineStartPC;
  378.                 ErrorLine := '';
  379.                 repeat
  380.                     str := '';
  381.                     if ord(macros[pc]) = ord(NewLineT) then {ppc-bug}
  382.                         leave;
  383.                     GetToken;
  384.                     ConvertTokenToString(str);
  385.                     if SavePC = ErrorPC then
  386.                         str := concat('«', str, '»');
  387.                     ErrorLine := concat(ErrorLine, ' ', str);
  388.                 until token = DoneT;
  389.             end;
  390.     end;
  391.  
  392.  
  393.     procedure GetLocalLineNumber;
  394.     begin
  395.         pc := PCStart;
  396.         MacroLineNumber := 1;
  397.         while (pc <= errorpc) and (token <> DoneT) do
  398.             GetToken;
  399.     end;
  400.  
  401.  
  402.     procedure GetGlobalLineNumber;
  403.     begin
  404.         pc := 0;
  405.         MacroLineNumber := 1;
  406.         while (pc <= errorpc) and (token <> DoneT) do
  407.             GetToken;
  408.     end;
  409.     
  410.  
  411.     procedure MacroError (str: str255);
  412.   {Report run-time errors}
  413.         var
  414.             name, ErrorLine, Line: str255;
  415.             i, count, ignore: integer;
  416.     begin
  417.         with MacrosP^ do begin
  418.                 if token = DoneT then
  419.                     exit(MacroError);
  420.                 if TopOfStack > 0 then
  421.                     DeAllocateStrings(nGlobals + 1, TopOfStack);
  422.                 ErrorPC := SavePC;
  423.                 if MacroOrProcName = BlankSymbol then
  424.                     GetMacroName;
  425.                 if MacroOrProcName[SymbolSize] <> ' ' then
  426.                     MacroOrProcName[SymbolSize] := '…';
  427.                 name:='123456789012';
  428.                 for i:=1 to 12 do name[i]:=MacroOrProcName[i];
  429.                 TrimString(name);
  430.                 GetLocalLineNumber;
  431.                 Line := StringOf(MacroLineNumber:1);
  432.                 GetErrorLine(ErrorLine);
  433.                 InitCursor;
  434.                 GetGlobalLineNumber;
  435.                 Line:=StringOf(Line,' (',MacroLineNumber:1,')');
  436.                 ParamText(str, Line, Name, ErrorLine);
  437.                 Ignore := Alert(900, nil);
  438.                 Token := DoneT;
  439.             end; {with}
  440.     end;
  441.  
  442.  
  443.     procedure DoDeclaration;
  444.         var
  445.             SaveStackLoc, StackLoc: integer;
  446.     begin
  447.         SaveStackLoc := TopOfStack;
  448.         while (token = Identifier) or (token = variable) or (token = comma) or (token = StringVariable) do begin
  449.                 if TopOfStack >= MaxMacroStackSize then begin
  450.                         MacroError(StackOverflow);
  451.                         exit(DoDeclaration);
  452.                     end;
  453.                 TopOfStack := TopOfStack + 1;
  454.                 with MacrosP^.stack[TopOfStack] do begin
  455.                         SymbolTableIndex := SymbolTableLoc;
  456.                         value := 0.0;
  457.                         StringH := nil;
  458.                     end;
  459.                 GetToken;
  460.                 if token = comma then
  461.                     GetToken;
  462.             end; {while}
  463.         if (token = FunctionT) or (token = StringFunctionT) or (token = CommandT) or (token = ArrayT) then
  464.             MacroError('Predefined identifier');
  465.         if token <> colon then
  466.             MacroError('":" expected');
  467.         GetToken;
  468.         if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
  469.             MacroError('"integer", "real", "boolean" or "string" expected');
  470.         for StackLoc := SaveStackLoc + 1 to TopOfStack do
  471.             with macrosP^.stack[StackLoc] do
  472.                 case token of
  473.                     IntegerT: 
  474.                         vType := IntVar;
  475.                     RealT: 
  476.                         vType := RealVar;
  477.                     BooleanT: 
  478.                         vType := BooleanVar;
  479.                     StringT:  begin
  480.                             StringsAllocated := true;
  481.                             vType := StringVar;
  482.                             StringH := str255H(NewHandle(SizeOf(str255)));
  483.                             if StringH = nil then begin
  484.                                     MacroError('Out of memory');
  485.                                     Token := DoneT
  486.                                 end
  487.                             else
  488.                                 StringH^^ := 'Local String';
  489.                         end;
  490.                     otherwise
  491.                 end;
  492.         GetToken;
  493.         if Token = SemiColon then
  494.             GetToken;
  495.     end;
  496.  
  497.  
  498.     procedure GetLeftParen;
  499.     begin
  500.         GetToken;
  501.         if token <> LeftParen then
  502.             MacroError('"(" expected');
  503.     end;
  504.  
  505.  
  506.     procedure GetRightParen;
  507.     begin
  508.         GetToken;
  509.         if token <> RightParen then
  510.             MacroError(RightParenExpected);
  511.     end;
  512.  
  513.  
  514.     procedure GetComma;
  515.     begin
  516.         GetToken;
  517.         if token <> comma then
  518.             MacroError('"," expected');
  519.     end;
  520.  
  521.  
  522.     procedure GetArguments (var str: str255);
  523.         var
  524.             width, fwidth: integer;
  525.             i: LongInt;
  526.             isExpression, ZeroFill, noArgs, notFormatted: boolean;
  527.             isUserFunction: boolean;
  528.             n: extended;
  529.             str2: str255;
  530.     begin
  531.         if MacroCommand = WritelnC then begin {Check for Writeln with no arguments}
  532.                 GetToken;
  533.                 noArgs := token <> LeftParen;
  534.                 PutTokenBack;
  535.                 if NoArgs then begin
  536.                         str := '';
  537.                         exit(GetArguments);
  538.                     end;
  539.             end;
  540.         ZeroFill := not (MacroCommand in [DrawTextC, WriteC, WritelnC, PutMsgC, ShowMsgC, PutSerialC, ConcatC]);
  541.         width := 4;
  542.         fwidth := 0;
  543.         str := '';
  544.         GetLeftParen;
  545.         GetToken;
  546.         repeat
  547.             notFormatted := true;
  548.             if token = UserFunctionT then begin
  549.                     DoUserFunction;
  550.                     isExpression := TokenStr = 'No return string';
  551.                     if isExpression then
  552.                         n := TokenValue
  553.                     else
  554.                         str2 := TokenStr;
  555.             end else begin
  556.                     isExpression := token in [Variable, NumericLiteral, FunctionT, TrueT, FalseT, ArrayT, MinusOp, LeftParen];
  557.                     PutTokenBack;
  558.                     if isExpression then
  559.                         n := GetBooleanExpression
  560.                     else
  561.                         str2 := GetString;
  562.             end;
  563.             GetToken;
  564.             if token = colon then begin
  565.                     notFormatted := false;
  566.                     width := GetInteger;
  567.                     if width < 0 then
  568.                         width := 0;
  569.                     if width > 100 then
  570.                         width := 100;
  571.                     GetToken;
  572.                     if token = colon then begin
  573.                             fwidth := GetInteger;
  574.                             if fwidth < 0 then
  575.                                 width := 0;
  576.                             if fwidth > 12 then
  577.                                 width := 12;
  578.                             GetToken;
  579.                         end;
  580.                 end;
  581.             if token = comma then
  582.                 GetToken;
  583.             if isExpression then begin
  584.                     if notFormatted then
  585.                         if (trunc(n) <> n) and (not ZeroFill) then begin
  586.                                 width := 1;
  587.                                 fwidth := 4;
  588.                             end;
  589.                     str2:=StringOf(n:width:fwidth);
  590.                     if ZeroFill and (n >= 0) then
  591.                         for i := 1 to width do
  592.                             if str2[i] = ' ' then
  593.                                 str2[i] := '0';
  594.                 end;
  595.             str := concat(str, str2);
  596.         until (token = RightParen) or (token = DoneT);
  597.     end;
  598.  
  599.  
  600.     function DoGetString: str255; {(prompt,default:str255)}
  601.         const
  602.             StringID = 3;
  603.         var
  604.             prompt, default: str255;
  605.             Canceled: boolean;
  606.             mylog: DialogPtr;
  607.             item: integer;
  608.     begin
  609.         GetLeftParen;
  610.         prompt := GetString;
  611.         GetToken;
  612.         if token = Comma then
  613.             default := GetString
  614.         else begin
  615.                 default := '';
  616.                 PutTokenBack
  617.             end;
  618.         GetRightParen;
  619.         if Token <> DoneT then begin
  620.                 InitCursor;
  621.                 ParamText(prompt, '', '', '');
  622.                 mylog := GetNewDialog(170, nil, pointer(-1));
  623.                 SetDString(MyLog, StringID, default);
  624.                 SelectdialogItemText(MyLog, StringID, 0, 32767);
  625.                 OutlineButton(MyLog, ok, 16);
  626.                 repeat
  627.                     ModalDialog(nil, item);
  628.                 until (item = ok) or (item = cancel);
  629.                 if item = ok then
  630.                     DoGetString := GetDString(MyLog, StringID)
  631.                 else begin
  632.                         DoGetString := 'cancel';
  633.                         token := DoneT;
  634.                     end;
  635.                 DisposeDialog(mylog);
  636.             end;
  637.     end;
  638.  
  639.  
  640.     function GetSerial: str255;
  641.         var
  642.             count: LongInt;
  643.             buffer: packed array[1..100] of char;
  644.             err: OSErr;
  645.             c:char;
  646.     begin
  647.         if SerialBufferP = nil then begin
  648.                 MacroError('Serial port not open');
  649.                 exit(GetSerial);
  650.             end;
  651.         Err := SerGetBuf(SerialIn, count);
  652.         if count > 0 then begin
  653.                 count := 1;
  654.             Err := FSRead(SerialIn, count, @buffer);
  655.             c:=buffer[1]; {ppc-bug}
  656.             GetSerial :=c;
  657.             end
  658.         else
  659.             GetSerial := '';
  660.     end;
  661.  
  662.  
  663.     procedure RangeCheck (i: LongInt);
  664.     begin
  665.         if (i < 0) or (i > 255) then
  666.             MacroError('Argument is less than 0 or greater than 255');
  667.     end;
  668.  
  669.  
  670.     function DoChr: str255;
  671.         var
  672.             i: LongInt;
  673.     begin
  674.         GetLeftParen;
  675.         i := GetInteger;
  676.         GetRightParen;
  677.         RangeCheck(i);
  678.         if Token <> DoneT then begin
  679.             DoChr := chr(i);
  680.         end;
  681.     end;
  682.  
  683.  
  684.     function GetWindowTitle: str255;
  685.         var
  686.             wPeek: WindowPeek;
  687.     begin
  688.         wPeek := WindowPeek(FrontWindow);
  689.         if wPeek = nil then begin
  690.                 GetWindowTitle := '';
  691.                 exit(GetWindowTitle);
  692.             end;
  693.         if wPeek^.WindowKind = PicKind then
  694.             GetWindowTitle := Info^.title
  695.         else
  696.             GetWindowTitle := wPeek^.TitleHandle^^;
  697.     end;
  698.  
  699.  
  700.     function GetPath (vRefnum: Integer; DirID: LongInt): Str255;
  701.     { from 'Inside Macintosh: Files' }
  702.     var
  703.       myPB:     CInfoPBRec;
  704.       dirName:  Str255;
  705.       fullPath: Str255;
  706.       myErr:    OSErr;
  707.     begin
  708.       fullPath := '';
  709.       myPB.ioNamePtr := @dirName;
  710.       myPB.ioVRefNum := vRefNum;
  711.       myPB.ioDrParID := DirId;
  712.       myPB.ioFDirIndex := -1;
  713.       repeat
  714.         myPB.ioDrDirID := myPB.ioDrParID;
  715.         myErr := PBGetCatInfoSync(@myPB);
  716.         dirName := concat(dirName, ':');
  717.         fullPath := concat(dirName, fullPath);
  718.       until myPB.ioDrDirID = fsRtDirID;
  719.       GetPath := fullPath;
  720.     end;
  721.  
  722.  
  723.     function DoGetPath: str255;
  724.     var
  725.         err: OSErr;
  726.         PrefsVRef: integer;
  727.         PrefsDirID: LongInt;
  728.         PathType: str255;
  729.     begin
  730.         GetLeftParen;
  731.         PathType := GetString;
  732.         GetRightParen;
  733.         if Token <> DoneT then begin
  734.             DoGetPath := '';
  735.             MakeLowerCase(PathType);
  736.             if pos('window', PathType) <> 0 then begin
  737.                 if (CurrentWindow = textKind) and (TextInfo <> nil) then begin
  738.                     if TextInfo^.TextRefNum <> 0 then
  739.                         DoGetPath := GetPath(TextInfo^.TextRefNum, 0)
  740.                 end else if (CurrentWindow = PicKind) and (info^.vRef <> 0) then
  741.                     DoGetPath := GetPath(info^.vRef, 0)
  742.             end else if pos('start', PathType) <> 0 then
  743.                 DoGetPath := GetPath(StartupSpec.vRefNum, StartupSpec.parID)
  744.             else if pos('pref', PathType) <> 0 then begin
  745.                 err:=FindFolder(kOnSystemDisk, kPreferencesFolderType,
  746.                     kDontCreateFolder, PrefsVRef, PrefsDirID);
  747.                 if err = noErr then
  748.                     DoGetPath := GetPath(PrefsVRef, PrefsDirID)
  749.             end else
  750.                 MacroError('Unrecognized argument');
  751.         end;
  752.     end;
  753.     
  754.     
  755.     function DoStringFunction: str255;
  756.         var
  757.             str: str255;
  758.     begin
  759.         case MacroCommand of
  760.             GetStringC: 
  761.                 DoStringFunction := DoGetString;
  762.             ChrC: 
  763.                 DoStringFunction := DoChr;
  764.             GetSerialC: 
  765.                 DoStringFunction := GetSerial;
  766.             ConcatC:  begin
  767.                     GetArguments(str);
  768.                     DoStringFunction := str;
  769.                 end;
  770.             WindowTitleC: 
  771.                 DoStringFunction := GetWindowTitle;
  772.             GetPathC:
  773.                 DoStringFunction := DoGetPath;
  774.             otherwise
  775.                 MacroError('"GetString ", "GetSerial" or "chr" expected');
  776.         end;
  777.     end;
  778.  
  779.  
  780.     function GetString: str255;
  781.     begin
  782.         GetToken;
  783.         if token = StringFunctionT then
  784.             GetString := DoStringFunction
  785.         else if (token = StringLiteral) or (token = StringVariable) then
  786.             GetString := TokenStr
  787.         else if token = UserFunctionT then begin
  788.             DoUserFunction;
  789.             GetString := TokenStr
  790.         end else begin
  791.                 MacroError('String expected');
  792.                 GetString := '';
  793.             end;
  794.     end;
  795.  
  796.  
  797.     function GetInteger: LongInt;
  798.         var
  799.             n: LongInt;
  800.             r: extended;
  801.     begin
  802.         r := GetExpression;
  803.         if token = DoneT then begin
  804.                 GetInteger := 0;
  805.                 exit(GetInteger);
  806.             end;
  807.         GetInteger := round(r);
  808.     end;
  809.  
  810.  
  811.     procedure CheckBoolean (b: extended);
  812.     begin
  813.         if (b <> ord(true)) and (b <> ord(false)) then
  814.             MacroError('Boolean expression expected');
  815.     end;
  816.  
  817.  
  818.     function GetBoolean: boolean;
  819.         var
  820.             value: extended;
  821.     begin
  822.         value := GetBooleanExpression;
  823.         CheckBoolean(value);
  824.         GetBoolean := value = ord(true);
  825.     end;
  826.  
  827.  
  828.     function GetBooleanArg: boolean;
  829.     begin
  830.         GetLeftParen;
  831.         GetBooleanArg := GetBoolean;
  832.         GetRightParen;
  833.     end;
  834.  
  835.  
  836.     function GetStringArg: str255;
  837.     begin
  838.         GetLeftParen;
  839.         GetStringArg := GetString;
  840.         GetRightParen;
  841.     end;
  842.  
  843.  
  844.     procedure DoConvolve;
  845.         var
  846.             err: OSErr;
  847.             f: integer;
  848.             FileFound: boolean;
  849.             fname: str255;
  850.     begin
  851.         fname := GetStringArg;
  852.         if token <> DoneT then begin
  853.                 if (fname = '') and (CurrentWindow = TextKind) then begin
  854.                         ConvolveUsingText;
  855.                         exit(DoConvolve);
  856.                     end;
  857.                 err := fsopen(fname, KernelsRefNum, f);
  858.                 FileFound := err = NoErr;
  859.                 err := fsclose(f);
  860.                 if FileFound then
  861.                     convolve(fname, KernelsRefNum)
  862.                 else
  863.                     convolve('', 0);
  864.             end;
  865.     end;
  866.  
  867.  
  868.     function GetNumber: extended; {(prompt:str255; default:extended; [precision:integer])}
  869.         var
  870.             prompt: str255;
  871.             default, n: extended;
  872.             Canceled, OptionalArgument: boolean;
  873.     begin
  874.         GetLeftParen;
  875.         prompt := GetString;
  876.         GetComma;
  877.         default := GetExpression;
  878.         GetToken;
  879.         OptionalArgument := token <> RightParen;
  880.         PutTokenBack;
  881.         if OptionalArgument then begin
  882.                 GetComma;
  883.                 precision := GetInteger;
  884.                 if precision < 0 then
  885.                     precision := 0;
  886.                 if precision > 5 then
  887.                     precision := 5;
  888.         end else
  889.                 precision := 2;
  890.         GetRightParen;
  891.         n := 0.0;
  892.         if Token <> DoneT then begin
  893.                 n := GetReal(prompt, default, precision, Canceled);
  894.                 if Canceled then begin
  895.                         n := default;
  896.                         token := DoneT;
  897.                     end;
  898.             end;
  899.         GetNumber := n;
  900.     end;
  901.  
  902.  
  903.     function DoGetPixel: extended; {(hloc,vloc:integer)}
  904.         var
  905.             hloc, vloc: LongInt;
  906.     begin
  907.         GetLeftParen;
  908.         hloc := GetInteger;
  909.         GetComma;
  910.         vloc := GetInteger;
  911.         GetRightParen;
  912.         if (Token <> DoneT) and (info <> NoInfo) then
  913.             DoGetPixel := MyGetPixel(hloc, vloc)
  914.         else
  915.             DoGetPixel := 0.0;
  916.     end;
  917.  
  918.  
  919.     function DoFunction (c: CommandType): extended;
  920.         var
  921.             n: extended;
  922.             SaveCommand: CommandType;
  923.     begin
  924.         SaveCommand := MacroCommand;
  925.         GetLeftParen;
  926.         n := GetExpression;
  927.         GetRightParen;
  928.         if Token <> DoneT then
  929.             case SaveCommand of
  930.                 truncC: 
  931.                     DoFunction := trunc(n);
  932.                 roundC: 
  933.                     DoFunction := round(n);
  934.                 oddC: 
  935.                     if odd(trunc(n)) then
  936.                         DoFunction := ord(true)
  937.                     else
  938.                         DoFunction := ord(false);
  939.                 absC: 
  940.                     DoFunction := abs(n);
  941.                 sqrtC: 
  942.                     if n < 0.0 then
  943.                         MacroError('Sqrt Error')
  944.                     else
  945.                         DoFunction := sqrt(n);
  946.                 sqrC: 
  947.                     DoFunction := sqr(n);
  948.                 sinC: 
  949.                     DoFunction := sin(n);
  950.                 cosC: 
  951.                     DoFunction := cos(n);
  952.                 expC: 
  953.                     DoFunction := exp(n);
  954.                 lnC: 
  955.                     if n <= 0.0 then
  956.                         MacroError('Log Error')
  957.                     else
  958.                         DoFunction := ln(n);
  959.                 arctanC: 
  960.                     DoFunction := arctan(n);
  961.             end
  962.         else
  963.             DoFunction := 0.0;
  964.     end;
  965.  
  966.  
  967.     function CalibrateValue: extended;
  968.         var
  969.             i: integer;
  970.     begin
  971.         GetLeftParen;
  972.         i := GetInteger;
  973.         GetRightParen;
  974.         RangeCheck(i);
  975.         if Token <> DoneT then begin
  976.                 CalibrateValue := cvalue[i];
  977.             end;
  978.     end;
  979.  
  980.  
  981.     function DoOrd: extended;
  982.         var
  983.             str: str255;
  984.     begin
  985.         GetLeftParen;
  986.         str := GetString;
  987.         GetRightParen;
  988.         if Token <> DoneT then begin
  989.                 if length(str) >= 1 then
  990.                     DoOrd := ord(str[1])
  991.                 else
  992.                     DoOrd := -1;
  993.             end;
  994.     end;
  995.  
  996.  
  997.     function DoStringToNum: extended;
  998.         var
  999.             str: str255;
  1000.             n: extended;
  1001.     begin
  1002.         GetLeftParen;
  1003.         str := GetString;
  1004.         GetRightParen;
  1005.         if Token <> DoneT then begin
  1006.                 n := StringToReal(str);
  1007.                 if n = BadReal then
  1008.                     DoStringToNum := 0.0
  1009.                 else
  1010.                     DoStringToNum := n;
  1011.             end;
  1012.     end;
  1013.  
  1014.  
  1015.     function DoLogicalFunction (c: CommandType): extended;
  1016.         var
  1017.             n1, n2: LongInt;
  1018.     begin
  1019.         GetLeftParen;
  1020.         n1 := GetInteger;
  1021.         GetComma;
  1022.         n2 := GetInteger;
  1023.         GetRightParen;
  1024.         if Token <> DoneT then begin
  1025.                 if c = BitAndC then
  1026.                     DoLogicalFunction := band(n1, n2)
  1027.                 else
  1028.                     DoLogicalFunction := bor(n1, n2)
  1029.             end;
  1030.     end;
  1031.  
  1032.  
  1033.     function PidExists: boolean; {(pid:integer)}
  1034.         var
  1035.             pid, i: integer;
  1036.     begin
  1037.         GetLeftParen;
  1038.         pid := GetInteger;
  1039.         GetRightParen;
  1040.         if Token <> DoneT then begin
  1041.                 PidExists := false;
  1042.                 for i := 1 to nPics do
  1043.                     if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = pid then begin
  1044.                             PidExists := true;
  1045.                             leave;
  1046.                         end;
  1047.             end;
  1048.     end;
  1049.  
  1050.  
  1051.     function DoPos: integer;
  1052.         var
  1053.             substr, str: str255;
  1054.     begin
  1055.         GetLeftParen;
  1056.         substr := GetString;
  1057.         GetComma;
  1058.         str := GetString;
  1059.         GetRightParen;
  1060.         if Token <> DoneT then
  1061.             DoPos := pos(substr, str);
  1062.     end;
  1063.  
  1064.  
  1065.     function DoLength: integer;
  1066.         var
  1067.             str: str255;
  1068.     begin
  1069.         GetLeftParen;
  1070.         str := GetString;
  1071.         GetRightParen;
  1072.         if Token <> DoneT then
  1073.             DoLength := length(str);
  1074.     end;
  1075.  
  1076.  
  1077.     function isKeyDown:boolean; {(key:string)}
  1078.         var
  1079.             key: str255;
  1080.     begin
  1081.         GetLeftParen;
  1082.         key := GetString;
  1083.         GetRightParen;
  1084.         if token <> DoneT then begin
  1085.             MakeLowerCase(key);
  1086.             isKeydown:=false;
  1087.             if (pos('option', key) <> 0) and OptionKeyDown then
  1088.                 isKeyDown:=true
  1089.             else if (pos('shift', key) <> 0) and ShiftKeyDown then
  1090.                 isKeyDown:=true
  1091.             else if (pos('control', key) <> 0) and ControlKeyDown then
  1092.                 isKeyDown:=true;
  1093.         end;
  1094.     end;
  1095.  
  1096.  
  1097.     function GetParameter:LongInt; {parameter:string}
  1098.         var
  1099.             param: str255;
  1100.     begin
  1101.         GetLeftParen;
  1102.         param := GetString;
  1103.         GetRightParen;
  1104.         if token <> DoneT then begin
  1105.             MakeLowerCase(param);
  1106.             if pos('maxmeasure', param) <> 0 then
  1107.                 GetParameter := MaxMeasurements
  1108.             else if pos('undo', param) <> 0 then
  1109.                 GetParameter := UndoBufSize
  1110.             else if pos('freemem', param) <> 0 then
  1111.                 GetParameter := FreeMem
  1112.             else if pos('maxblock', param) <> 0 then
  1113.                 GetParameter := MaxBlock
  1114.             else if pos('roitype', param) <> 0 then begin
  1115.                 if info = nil then
  1116.                     GetParameter := 0
  1117.                 else case Info^.RoiType of
  1118.                     noRoi: GetParameter := 0;
  1119.                     RectRoi: GetParameter := 1;
  1120.                     OvalRoi: GetParameter := 2;
  1121.                     PolygonRoi: GetParameter := 3;
  1122.                     FreehandRoi: GetParameter := 4;
  1123.                     TracedRoi: GetParameter := 5;
  1124.                     LineRoi: GetParameter := 6;
  1125.                     FreeLineRoi: GetParameter := 7;
  1126.                     SegLineRoi: GetParameter := 8;
  1127.                 end
  1128.             end else begin
  1129.                 MacroError('Invalid argument');
  1130.                 GetParameter := 0;
  1131.             end;
  1132.         end;
  1133.     end;
  1134.  
  1135.  
  1136.     function ExecuteFunction: extended;
  1137.     begin
  1138.         case MacroCommand of
  1139.             TruncC, RoundC, oddC, absC, sqrtC, sqrC, sinC, cosC, expC, lnC, arctanC: 
  1140.                 ExecuteFunction := DoFunction(MacroCommand);
  1141.             GetNumC: 
  1142.                 ExecuteFunction := GetNumber;
  1143.             RandomC: 
  1144.                 ExecuteFunction := (random + 32767.0) / 65534.0;
  1145.             GetPixelC: 
  1146.                 ExecuteFunction := DoGetPixel;
  1147.             ButtonC:  begin
  1148.                     ExecuteFunction := ord(Button);
  1149.                     FlushEvents(EveryEvent, 0);
  1150.                 end;
  1151.             nPicsC: 
  1152.                 ExecuteFunction := nPics;
  1153.             PicNumC: 
  1154.                 ExecuteFunction := info^.PicNum;
  1155.             PidNumC: 
  1156.                 ExecuteFunction := info^.PidNum;
  1157.             PidExistsC: 
  1158.                 ExecuteFunction := ord(PidExists);
  1159.             SameSizeC: 
  1160.                 ExecuteFunction := ord(AllSameSize);
  1161.             cValueC: 
  1162.                 ExecuteFunction := CalibrateValue;
  1163.             CalibratedC: 
  1164.                 ExecuteFunction := ord(info^.fit <> uncalibrated);
  1165.             rCountC: 
  1166.                 ExecuteFunction := mCount;
  1167.             GetSliceC: 
  1168.                 with info^ do
  1169.                     if StackInfo = nil then
  1170.                         ExecuteFunction := 0
  1171.                     else
  1172.                         ExecuteFunction := Info^.StackInfo^.CurrentSlice;
  1173.             nSlicesC: 
  1174.                 with info^ do
  1175.                     if StackInfo = nil then
  1176.                         ExecuteFunction := 0
  1177.                     else
  1178.                         ExecuteFunction := Info^.StackInfo^.nSlices;
  1179.             GetSpacingC: 
  1180.                 with info^ do
  1181.                     if StackInfo = nil then
  1182.                         MacroError('No stack')
  1183.                     else with Info^.StackInfo^ do begin
  1184.                         if StackType = MovieStack then
  1185.                             ExecuteFunction := Info^.StackInfo^.FrameInterval
  1186.                         else
  1187.                             ExecuteFunction := Info^.StackInfo^.SliceSpacing;
  1188.                     end;
  1189.             nCoordinatesC: 
  1190.                 ExecuteFunction := nCoordinates;
  1191.             OrdC: 
  1192.                 ExecuteFunction := DoOrd;
  1193.             TickCountC: 
  1194.                 ExecuteFunction := TickCount;
  1195.             StringToNumC: 
  1196.                 ExecuteFunction := DoStringToNum;
  1197.             UndoSizeC: 
  1198.                 ExecuteFunction := UndoBufSize;
  1199.             BitAndC, BitOrC: 
  1200.                 ExecuteFunction := DoLogicalFunction(MacroCommand);
  1201.             PosC: 
  1202.                 ExecuteFunction := DoPos;
  1203.             LengthC: 
  1204.                 ExecuteFunction := DoLength;
  1205.             KeyDownC:
  1206.                 ExecuteFunction := ord(isKeyDown);
  1207.             GetC:
  1208.                 ExecuteFunction := GetParameter;
  1209.         end; {case}
  1210.     end;
  1211.  
  1212.  
  1213.     procedure CheckIndex (index, min, max: LongInt);
  1214.     begin
  1215.         if (index < min) or (index > max) then
  1216.             MacroError('Array index out of range');
  1217.     end;
  1218.  
  1219.  
  1220.     function GetArrayValue: extended;
  1221.         var
  1222.             SaveArrayType: ArrayType;
  1223.             Index: LongInt;
  1224.             xcoord, ycoord: integer;
  1225.     begin
  1226.         SaveArrayType := ArrayType(MacroCommand);
  1227.         GetToken;
  1228.         if token <> LeftBracket then
  1229.             MacroError('"[" expected');
  1230.         Index := GetInteger;
  1231.         GetToken;
  1232.         if token <> RightBracket then
  1233.             MacroError('"]" expected');
  1234.         case SaveArrayType of
  1235.             HistogramA:  begin
  1236.                     RangeCheck(Index);
  1237.                     GetArrayValue := histogram[Index];
  1238.                 end;
  1239.             rAreaA:  begin
  1240.                     CheckIndex(Index, 1, MaxMeasurements);
  1241.                     GetArrayValue := mArea^[Index];
  1242.                 end;
  1243.             rMeanA:  begin
  1244.                     CheckIndex(Index, 1, MaxMeasurements);
  1245.                     GetArrayValue := mean^[Index];
  1246.                 end;
  1247.             rStdDevA:  begin
  1248.                     CheckIndex(Index, 1, MaxMeasurements);
  1249.                     GetArrayValue := sd^[Index];
  1250.                 end;
  1251.             rXA:  begin
  1252.                     CheckIndex(Index, 1, MaxMeasurements);
  1253.                     GetArrayValue := xcenter^[Index];
  1254.                 end;
  1255.             rYA:  begin
  1256.                     CheckIndex(Index, 1, MaxMeasurements);
  1257.                     GetArrayValue := ycenter^[Index];
  1258.                 end;
  1259.             rLengthA:  begin
  1260.                     CheckIndex(Index, 1, MaxMeasurements);
  1261.                     GetArrayValue := pLength^[Index];
  1262.                 end;
  1263.             rMinA:  begin
  1264.                     CheckIndex(Index, 1, MaxMeasurements);
  1265.                     GetArrayValue := mMin^[Index];
  1266.                 end;
  1267.             rMaxA:  begin
  1268.                     CheckIndex(Index, 1, MaxMeasurements);
  1269.                     GetArrayValue := mMax^[Index];
  1270.                 end;
  1271.             rMajorA:  begin
  1272.                     CheckIndex(Index, 1, MaxMeasurements);
  1273.                     GetArrayValue := MajorAxis^[Index];
  1274.                 end;
  1275.             rMinorA:  begin
  1276.                     CheckIndex(Index, 1, MaxMeasurements);
  1277.                     GetArrayValue := MinorAxis^[Index];
  1278.                 end;
  1279.             rAngleA:  begin
  1280.                     CheckIndex(Index, 1, MaxMeasurements);
  1281.                     GetArrayValue := orientation^[Index];
  1282.                 end;
  1283.             rUser1A:  begin
  1284.                     CheckIndex(Index, 1, MaxMeasurements);
  1285.                     GetArrayValue := User1^[Index];
  1286.                 end;
  1287.             rUser2A:  begin
  1288.                     CheckIndex(Index, 1, MaxMeasurements);
  1289.                     GetArrayValue := User2^[Index];
  1290.                 end;
  1291.             RedLutA, GreenLutA, BlueLutA: 
  1292.                 if OptionKeyDown then begin
  1293.                         RangeCheck(Index);
  1294.                         if Token <> DoneT then
  1295.                             with cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb do
  1296.                                 case SaveArrayType of
  1297.                                     RedLutA: 
  1298.                                         GetArrayValue := band(bsr(red, 8), 255);
  1299.                                     GreenLutA: 
  1300.                                         GetArrayValue := band(bsr(green, 8), 255);
  1301.                                     BlueLutA: 
  1302.                                         GetArrayValue := band(bsr(blue, 8), 255);
  1303.                                 end; {case}
  1304.                     end
  1305.                 else begin
  1306.                         RangeCheck(Index);
  1307.                         if Token <> DoneT then
  1308.                             with osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb do
  1309.                                 case SaveArrayType of
  1310.                                     RedLutA: 
  1311.                                         GetArrayValue := band(bsr(red, 8), 255);
  1312.                                     GreenLutA: 
  1313.                                         GetArrayValue := band(bsr(green, 8), 255);
  1314.                                     BlueLutA: 
  1315.                                         GetArrayValue := band(bsr(blue, 8), 255);
  1316.                                 end; {case}
  1317.                     end;
  1318.             BufferA:  begin
  1319.                     CheckIndex(Index, 0, MaxLine - 1);
  1320.                     if Token <> DoneT then
  1321.                         GetArrayValue := MacrosP^.aLine[index];
  1322.                 end;
  1323.             PlotDataA:  begin
  1324.                     CheckIndex(Index, 0, MaxLine - 1);
  1325.                     if Token <> DoneT then
  1326.                         GetArrayValue := PlotData^[index];
  1327.                 end;
  1328.             xCoordinatesA:  begin
  1329.                     CheckIndex(Index, 1, MaxCoordinates);
  1330.                     if Token <> DoneT then
  1331.                         with info^ do begin
  1332.                                 xcoord := xCoordinates^[index];
  1333.                                 if SpatiallyCalibrated then
  1334.                                     GetArrayValue := xcoord / xScale
  1335.                                 else
  1336.                                     GetArrayValue := xcoord
  1337.                             end;
  1338.                 end;
  1339.             yCoordinatesA:  begin
  1340.                     CheckIndex(Index, 1, MaxCoordinates);
  1341.                     if Token <> DoneT then
  1342.                         with info^ do begin
  1343.                                 ycoord := yCoordinates^[index];
  1344.                                 if InvertYCoordinates and (Info <> NoInfo) then
  1345.                                     ycoord := Info^.PicRect.bottom - ycoord - 1;
  1346.                                 if SpatiallyCalibrated then
  1347.                                     GetArrayValue := ycoord / yScale
  1348.                                 else
  1349.                                     GetArrayValue := ycoord
  1350.                             end;
  1351.                 end;
  1352.             ScionA:  begin
  1353.                     if framegrabber <> ScionLG3 then
  1354.                         MacroError('No Scion LG-3');
  1355.                     if Token <> DoneT then
  1356.                         CheckIndex(Index, 1, 4);
  1357.                     if Token <> DoneT then
  1358.                         case index of
  1359.                             1: 
  1360.                                 GetArrayValue := LG3DacA;
  1361.                             2: 
  1362.                                 GetArrayValue := LG3DacB;
  1363.                             3: 
  1364.                                 GetArrayValue := ControlReg^;
  1365.                             4: 
  1366.                                 GetArrayValue := LG3DataOut;
  1367.                         end;
  1368.                 end;
  1369.         end; {case}
  1370.     end;
  1371.  
  1372.  
  1373.     function GetStringValue: extended;
  1374.  {Convert string to a base 102 number so we can do comparisons.}
  1375.         const
  1376.             base = 102;
  1377.         var
  1378.             i, j: integer;
  1379.             v, k: extended;
  1380.     begin
  1381.         MakeLowerCase(TokenStr);
  1382.         k := 1;
  1383.         v := 0.0;
  1384.         for i := 1 to length(TokenStr) do begin
  1385.                 j := ord(TokenStr[i]);
  1386.                 if j > 127 then
  1387.                     j := 127;
  1388.                 if j >= 91 then
  1389.                     j := j - 26;
  1390.                 v := v + j * k;
  1391.                 k := k * base;
  1392.             end;
  1393.         GetStringValue := v;
  1394.     end;
  1395.  
  1396.  
  1397.  
  1398.     function GetValue: extended;
  1399.     begin
  1400.         case token of
  1401.             Variable, NumericLiteral: 
  1402.                 GetValue := TokenValue;
  1403.             FunctionT: 
  1404.                 GetValue := ExecuteFunction;
  1405.             StringFunctionT:  begin
  1406.                     TokenStr := DoStringFunction;
  1407.                     GetValue := GetStringValue;
  1408.                 end;
  1409.             UserFunctionT:  begin
  1410.                     DoUserFunction;
  1411.                     GetValue := TokenValue;
  1412.                 end;
  1413.             TrueT: 
  1414.                 GetValue := ord(true);
  1415.             FalseT: 
  1416.                 GetValue := ord(false);
  1417.             ArrayT: 
  1418.                 GetValue := GetArrayValue;
  1419.             StringVariable, StringLiteral: 
  1420.                 GetValue := GetStringValue;
  1421.             otherwise begin
  1422.                     MacroError('Number expected');
  1423.                     GetValue := 0.0;
  1424.                     exit(GetValue);
  1425.                 end;
  1426.         end; {case}
  1427.     end;
  1428.  
  1429.  
  1430.     function GetFactor: extended;
  1431.         var
  1432.             fValue: extended;
  1433.             isUnaryMinus, isNot: boolean;
  1434.     begin
  1435.         GetToken;
  1436.         isUnaryMinus := token = MinusOp;
  1437.         isNot := token = NotOp;
  1438.         if isUnaryMinus or isNot then
  1439.             GetToken;
  1440.         case token of
  1441.             Variable, NumericLiteral, FunctionT, UserFunctionT, StringFunctionT, 
  1442.             TrueT, FalseT, ArrayT, StringVariable, StringLiteral: 
  1443.                 fValue := GetValue;
  1444.             LeftParen:  begin
  1445.                     fValue := GetBooleanExpression;
  1446.                     GetRightParen;
  1447.                 end;
  1448.             otherwise begin
  1449.                     macroError('Undefined identifier');
  1450.                     fvalue := 0.0
  1451.                 end;
  1452.         end;
  1453.         if isUnaryMinus then
  1454.             fValue := -fValue;
  1455.         if isNot then
  1456.             if fValue = ord(true) then
  1457.                 fValue := ord(false)
  1458.             else
  1459.                 fValue := ord(true);
  1460.         GetFactor := fValue;
  1461.         GetToken;
  1462.     end;
  1463.  
  1464.  
  1465.     function GetTerm: extended;
  1466.         var
  1467.             tValue, fValue: extended;
  1468.             op: TokenTypeX;
  1469.     begin
  1470.         tValue := GetFactor;
  1471.         while token in [MulOp, IntDivOp, ModOp, DivOp, AndOp] do begin
  1472.                 op := token;
  1473.                 fValue := GetFactor;
  1474.                 case op of
  1475.                     MulOp: 
  1476.                         tValue := tValue * fValue;
  1477.                     IntDivOp: 
  1478.                         if fValue <> 0.0 then
  1479.                             tValue := trunc(tValue) div trunc(fValue)
  1480.                         else
  1481.                             MacroError(DivideByZero);
  1482.                     ModOp: 
  1483.                         if fValue <> 0.0 then
  1484.                             tValue := trunc(tValue) mod trunc(fValue)
  1485.                         else
  1486.                             MacroError(DivideByZero);
  1487.                     DivOp: 
  1488.                         if fValue <> 0.0 then
  1489.                             tValue := tValue / fValue
  1490.                         else
  1491.                             MacroError(DivideByZero);
  1492.                     AndOp:  begin
  1493.                             CheckBoolean(tValue);
  1494.                             CheckBoolean(fValue);
  1495.                             tValue := ord((tValue = ord(true)) and (fValue = ord(true)));
  1496.                         end;
  1497.                 end; {case}
  1498.             end; {while}
  1499.         GetTerm := tValue;
  1500.     end;
  1501.  
  1502.  
  1503.     function GetSimpleExpression: extended;
  1504.         var
  1505.             seValue, tValue: extended;
  1506.             op: TokenTypeX;
  1507.     begin
  1508.         seValue := GetTerm;
  1509.         while token in [PlusOp, MinusOp, OrOp] do begin
  1510.                 op := token;
  1511.                 tValue := GetTerm;
  1512.                 case op of
  1513.                     PlusOp: 
  1514.                         seValue := seValue + tValue;
  1515.                     MinusOp: 
  1516.                         seValue := seValue - tValue;
  1517.                     orOp:  begin
  1518.                             CheckBoolean(seValue);
  1519.                             CheckBoolean(tValue);
  1520.                             seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
  1521.                         end;
  1522.                 end;
  1523.             end;
  1524.         GetSimpleExpression := seValue;
  1525.     end;
  1526.  
  1527.  
  1528.     function GetExpression: extended;
  1529.         var
  1530.             seValue, tValue: extended;
  1531.             op: TokenTypeX;
  1532.     begin
  1533.         seValue := GetTerm;
  1534.         while token in [PlusOp, MinusOp, OrOp] do begin
  1535.                 op := token;
  1536.                 tValue := GetTerm;
  1537.                 case op of
  1538.                     PlusOp: 
  1539.                         seValue := seValue + tValue;
  1540.                     MinusOp: 
  1541.                         seValue := seValue - tValue;
  1542.                     orOp:  begin
  1543.                             CheckBoolean(seValue);
  1544.                             CheckBoolean(tValue);
  1545.                             seValue := ord((seValue = ord(true)) or (tValue = ord(true)));
  1546.                         end;
  1547.                 end;
  1548.             end;
  1549.         GetExpression := seValue;
  1550.         PutTokenBack;
  1551.     end;
  1552.  
  1553.  
  1554.     function GetBooleanExpression: extended;
  1555.         var
  1556.             eValue, seValue: extended;
  1557.             op: TokenTypeX;
  1558.     begin
  1559.         eValue := GetSimpleExpression;
  1560.         while token in [eqOp, ltOp, gtOp, neOp, leOp, geOp] do begin
  1561.                 op := token;
  1562.                 seValue := GetSimpleExpression;
  1563.                 case op of
  1564.                     eqOp: 
  1565.                         eValue := ord(eValue = seValue);
  1566.                     ltOp: 
  1567.                         eValue := ord(eValue < seValue);
  1568.                     gtOp: 
  1569.                         eValue := ord(eValue > seValue);
  1570.                     neOp: 
  1571.                         eValue := ord(eValue <> seValue);
  1572.                     leOp: 
  1573.                         eValue := ord(eValue <= seValue);
  1574.                     geOp: 
  1575.                         eValue := ord(eValue >= seValue);
  1576.                 end;
  1577.             end;
  1578.         GetBooleanExpression := eValue;
  1579.         PutTokenBack;
  1580.     end;
  1581.  
  1582.  
  1583. {$S}
  1584. {Routines from here to the end of the file go in the macro1 segment}
  1585.  
  1586.     procedure DoCapture;
  1587.     begin
  1588.         CaptureAndDisplayFrame;
  1589.         if ContinuousHistogram then
  1590.             ShowContinuousHistogram;
  1591.     end;
  1592.  
  1593.  
  1594.     procedure DoWait;
  1595.         var
  1596.             seconds: extended;
  1597.             SaveTicks: LongInt;
  1598.             str: str255;
  1599.             theEvent: EventRecord;
  1600.     begin
  1601.         GetLeftParen;
  1602.         seconds := GetExpression;
  1603.         GetRightParen;
  1604.         if Token <> DoneT then begin
  1605.                 SaveTicks := TickCount + round(seconds * 60.0);
  1606.                 repeat
  1607.                     if Digitizing then
  1608.                         DoCapture;
  1609.                     if EventAvail(everyEvent, theEvent) then
  1610.                         ; {Allows background tasks to run}
  1611.                 until (TickCount > SaveTicks) or CommandPeriod;
  1612.             end;
  1613.     end;
  1614.  
  1615.  
  1616.     procedure SetDensitySlice; {LowerLevel,UpperLevel:integer}
  1617.   {Disable density slicing if lower and upper=0 and enable it up lower and upper=255}
  1618.         var
  1619.             sStart, sEnd: integer;
  1620.     begin
  1621.         GetLeftParen;
  1622.         sStart := GetInteger;
  1623.         RangeCheck(sStart);
  1624.         GetComma;
  1625.         sEnd := GetInteger;
  1626.         RangeCheck(sEnd);
  1627.         GetRightParen;
  1628.         if Token <> DoneT then begin
  1629.                 DisableDensitySlice;
  1630.                 DisableThresholding;
  1631.                 if (sEnd < sStart) or ((sStart = 0) and (sEnd = 0)) then
  1632.                     exit(SetDensitySlice);
  1633.                 if not ((sStart = 255) and (sEnd = 255)) then begin
  1634.                         SliceStart := sStart;
  1635.                         SliceEnd := sEnd;
  1636.                         if SliceStart < 1 then
  1637.                             SliceStart := 1;
  1638.                         if SliceEnd > 254 then
  1639.                             SliceEnd := 254;
  1640.                     end;
  1641.                 EnableDensitySlice;
  1642.             end;
  1643.     end;
  1644.  
  1645.  
  1646.     procedure SetColor;
  1647.         var
  1648.             index: integer;
  1649.             SaveCommand: CommandType;
  1650.     begin
  1651.         SaveCommand := MacroCommand;
  1652.         GetLeftParen;
  1653.         index := GetInteger;
  1654.         GetRightParen;
  1655.         RangeCheck(index);
  1656.         if Token <> DoneT then begin
  1657.                 if SaveCommand = SetForeC then
  1658.                     SetForegroundColor(index)
  1659.                 else
  1660.                     SetBackgroundColor(index);
  1661.             end;
  1662.     end;
  1663.  
  1664.  
  1665.     procedure DoConstantArithmetic;
  1666.         var
  1667.             constant: extended;
  1668.             SaveCommand: CommandType;
  1669.     begin
  1670.         SaveCommand := MacroCommand;
  1671.         GetLeftParen;
  1672.         constant := GetExpression;
  1673.         GetRightParen;
  1674.         if token <> DoneT then
  1675.             case SaveCommand of
  1676.                 AddConstC: 
  1677.                     DoArithmetic(AddItem, constant);
  1678.                 MulConstC: 
  1679.                     DoArithmetic(MultiplyItem, constant);
  1680.             end;
  1681.     end;
  1682.  
  1683.  
  1684.     procedure GetNextWindow;
  1685.         var
  1686.             n: integer;
  1687.     begin
  1688.         n := info^.PicNum + 1;
  1689.         if n > nPics then
  1690.             n := 1;
  1691.         StopDigitizing;
  1692.         SaveRoi;
  1693.         DisableDensitySlice;
  1694.         SelectWindow(PicWindow[n]);
  1695.         Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
  1696.         ActivateWindow;
  1697.         GenerateValues;
  1698.         LoadLUT(info^.cTable);
  1699.         UpdatePicWindow;
  1700.     end;
  1701.  
  1702.  
  1703.     procedure DoRevert;
  1704.     begin
  1705.         if info^.revertable then begin
  1706.                 RevertToSaved;
  1707.                 UpdatePicWindow;
  1708.             end
  1709.         else
  1710.             MacroError('Unable to revert');
  1711.     end;
  1712.  
  1713.  
  1714.     procedure MakeRoi;
  1715.         var
  1716.             Left, Top, Width, Height: integer;
  1717.             SaveCommand: CommandType;
  1718.     begin
  1719.         SaveCommand := MacroCommand;
  1720.         GetLeftParen;
  1721.         left := GetInteger;
  1722.         GetComma;
  1723.         top := GetInteger;
  1724.         GetComma;
  1725.         width := GetInteger;
  1726.         if width < 1 then
  1727.             width := 1;
  1728.         GetComma;
  1729.         height := GetInteger;
  1730.         if height < 1 then
  1731.             height := 1;
  1732.         GetRightParen;
  1733.         KillRoi;
  1734.         if token <> DoneT then
  1735.             with Info^ do begin
  1736.                     StopDigitizing;
  1737.                     if SaveCommand = MakeOvalC then
  1738.                         RoiType := OvalRoi
  1739.                     else
  1740.                         RoiType := RectRoi;
  1741.                     SetRect(RoiRect, left, top, left + width, top + height);
  1742.                     MakeRegion;
  1743.                     SetupUndo;
  1744.                     RoiShowing := true;
  1745.                 end;
  1746.     end;
  1747.  
  1748.  
  1749.     procedure MoveRoi;
  1750.         var
  1751.             DeltaH, DeltaV: integer;
  1752.     begin
  1753.         GetLeftParen;
  1754.         DeltaH := GetInteger;
  1755.         GetComma;
  1756.         DeltaV := GetInteger;
  1757.         GetRightParen;
  1758.         with info^ do begin
  1759.                 if not RoiShowing then begin
  1760.                         MacroError('No Selection');
  1761.                         exit(MoveRoi);
  1762.                     end;
  1763.                 OffsetRgn(roiRgn, DeltaH, DeltaV);
  1764.                 RoiRect := roiRgn^^.rgnBBox;
  1765.             end;
  1766.     end;
  1767.  
  1768.  
  1769.     procedure InsetRoi;
  1770.         var
  1771.             delta: integer;
  1772.     begin
  1773.         GetLeftParen;
  1774.         delta := GetInteger;
  1775.         GetRightParen;
  1776.         with info^ do begin
  1777.                 if not RoiShowing then begin
  1778.                         MacroError('No Selection');
  1779.                         exit(InsetRoi);
  1780.                     end;
  1781.                 InsetRgn(roiRgn, delta, delta);
  1782.                 RoiRect := roiRgn^^.rgnBBox;
  1783.             end;
  1784.     end;
  1785.  
  1786.  
  1787.     procedure DoMoveTo; {(x,y:integer)}
  1788.     begin
  1789.         GetLeftParen;
  1790.         CurrentX := GetInteger;
  1791.         GetComma;
  1792.         CurrentY := GetInteger;
  1793.         GetRightParen;
  1794.         InsertionPoint.h := CurrentX;
  1795.         InsertionPoint.v := CurrentY + 4;
  1796.     end;
  1797.  
  1798.  
  1799.     procedure DoDrawtext (str: str255; EndOfLine: boolean);
  1800.     begin
  1801.         if info <> NoInfo then begin
  1802.                 KillRoi;
  1803.                 DrawTextString(str, InsertionPoint, TextJust);
  1804.                 if EndOfLine then begin
  1805.                         CurrentY := CurrentY + CurrentSize;
  1806.                         InsertionPoint.h := CurrentX;
  1807.                         InsertionPoint.v := CurrentY + 4;
  1808.                     end;
  1809.             end;
  1810.     end;
  1811.  
  1812.  
  1813.     procedure DrawNumber;
  1814.         var
  1815.             n: extended;
  1816.             str: str255;
  1817.             fwidth: integer;
  1818.     begin
  1819.         GetLeftParen;
  1820.         n := GetExpression;
  1821.         GetRightParen;
  1822.         if token <> DoneT then begin
  1823.                 if n = trunc(n) then
  1824.                     fwidth := 0
  1825.                 else
  1826.                     fwidth := precision;
  1827.                 RealToString(n, 1, fwidth, str);
  1828.                 DoDrawText(str, true);
  1829.             end;
  1830.     end;
  1831.  
  1832.  
  1833.     procedure SetFont;
  1834.         var
  1835.             FontName: str255;
  1836.             id: integer;
  1837.     begin
  1838.         FontName := GetStringArg;
  1839.         if Token <> DoneT then begin
  1840.                 GetFNum(FontName, id);
  1841.                 if id = 0 then
  1842.                     MacroError('Font not available')
  1843.                 else
  1844.                     CurrentFontID := id;
  1845.             end;
  1846.     end;
  1847.  
  1848.  
  1849.     procedure SetFontSize;
  1850.         var
  1851.             size: integer;
  1852.     begin
  1853.         GetLeftParen;
  1854.         Size := GetInteger;
  1855.         GetRightParen;
  1856.         if (size < 6) or (size > 720) then
  1857.             MacroError('Argument out of range');
  1858.         if Token <> DoneT then
  1859.             CurrentSize := size;
  1860.     end;
  1861.  
  1862.  
  1863.     procedure SetText;
  1864.         var
  1865.             Attributes: str255;
  1866.     begin
  1867.         Attributes := GetStringArg;
  1868.         if Token <> DoneT then begin
  1869.                 MakeLowerCase(Attributes);
  1870.                 if pos('with', Attributes) <> 0 then
  1871.                     TextBack := WithBack;
  1872.                 if pos('no', Attributes) <> 0 then
  1873.                     TextBack := NoBack;
  1874.                 if pos('left', Attributes) <> 0 then
  1875.                     TextJust := teJustLeft;
  1876.                 if pos('center', Attributes) <> 0 then
  1877.                     TextJust := teJustCenter;
  1878.                 if pos('right', Attributes) <> 0 then
  1879.                     TextJust := teJustRight;
  1880.                 CurrentStyle := [];
  1881.                 if pos('bold', Attributes) <> 0 then
  1882.                     CurrentStyle := CurrentStyle + [Bold];
  1883.                 if pos('italic', Attributes) <> 0 then
  1884.                     CurrentStyle := CurrentStyle + [Italic];
  1885.                 if pos('underline', Attributes) <> 0 then
  1886.                     CurrentStyle := CurrentStyle + [Underline];
  1887.                 if pos('outline', Attributes) <> 0 then
  1888.                     CurrentStyle := CurrentStyle + [Outline];
  1889.                 if pos('shadow', Attributes) <> 0 then
  1890.                     CurrentStyle := CurrentStyle + [Shadow];
  1891.             end;
  1892.     end;
  1893.  
  1894.  
  1895.     procedure DoPutMessage;
  1896.         var
  1897.             str: str255;
  1898.     begin
  1899.         GetArguments(str);
  1900.         if Token <> DoneT then
  1901.             PutMessage(str)
  1902.     end;
  1903.  
  1904.  
  1905.     function GetVar: integer;
  1906.     begin
  1907.         GetVar := 0;
  1908.         GetToken;
  1909.         if token <> Variable then
  1910.             MacroError('Variable expected')
  1911.         else
  1912.             GetVar := TokenStackLoc;
  1913.     end;
  1914.  
  1915.  
  1916.     procedure GetPicSize;  {(width,height)}
  1917.         var
  1918.             loc1, loc2: integer;
  1919.     begin
  1920.         GetLeftParen;
  1921.         loc1 := GetVar;
  1922.         GetComma;
  1923.         loc2 := GetVar;
  1924.         GetRightParen;
  1925.         if Token <> DoneT then
  1926.             with MacrosP^ do
  1927.                 if info = NoInfo then begin
  1928.                         stack[loc1].value := 0.0;
  1929.                         stack[loc2].value := 0.0;
  1930.                     end
  1931.                 else
  1932.                     with info^ do begin
  1933.                             stack[loc1].value := PixelsPerLine;
  1934.                             stack[loc2].value := nLines;
  1935.                         end;
  1936.     end;
  1937.  
  1938.  
  1939.     procedure GetRoi;  {(hloc,vloc,width,height)}
  1940.         var
  1941.             loc1, loc2, loc3, loc4: integer;
  1942.     begin
  1943.         GetLeftParen;
  1944.         loc1 := GetVar;
  1945.         GetComma;
  1946.         loc2 := GetVar;
  1947.         GetComma;
  1948.         loc3 := GetVar;
  1949.         GetComma;
  1950.         loc4 := GetVar;
  1951.         GetRightParen;
  1952.         if Token <> DoneT then
  1953.             with MacrosP^, Info^ do
  1954.                 if RoiShowing then
  1955.                     with RoiRect do begin
  1956.                             stack[loc1].value := left;
  1957.                             stack[loc2].value := top;
  1958.                             stack[loc3].value := right - left;
  1959.                             stack[loc4].value := bottom - top;
  1960.                         end
  1961.                 else begin
  1962.                         stack[loc1].value := 0.0;
  1963.                         stack[loc2].value := 0.0;
  1964.                         stack[loc3].value := 0.0;
  1965.                         stack[loc4].value := 0.0;
  1966.                     end;
  1967.     end;
  1968.  
  1969.  
  1970.     procedure CaptureOneFrame;
  1971.     begin
  1972.         if FrameGrabber = noFrameGrabber then
  1973.             MacroError('Frame grabber not installed')
  1974.         else begin
  1975.                 StartDigitizing;
  1976.                 CaptureAndDisplayFrame;
  1977.                 StopDigitizing;
  1978.             end;
  1979.     end;
  1980.  
  1981.  
  1982.     procedure DoMakeNewWindow; {(name:str255)}
  1983.         var
  1984.             name: str255;
  1985.     begin
  1986.         GetArguments(name);
  1987.         if token <> DoneT then
  1988.             if (NewPicWidth * NewPicHeight) > UndoBufSize then
  1989.                 MacroError('New window larger than Undo buffer')
  1990.             else if not NewPicWindow(name, NewPicWidth, NewPicHeight) then
  1991.                 MacroError('Out of memory');
  1992.     end;
  1993.  
  1994.  
  1995.     procedure DoSetPalette;
  1996.         var
  1997.             PaletteType: str255;
  1998.             ok, OptionalArgument: boolean;
  1999.             nExtra: LongInt;
  2000.     begin
  2001.         GetLeftParen;
  2002.         PaletteType := GetString;
  2003.         GetToken;
  2004.         OptionalArgument := token <> RightParen;
  2005.         PutTokenBack;
  2006.         if OptionalArgument then begin
  2007.                 GetComma;
  2008.                 nExtra := GetInteger;
  2009.                 if nExtra < 0 then
  2010.                     nExtra := 0;
  2011.                 if nExtra > 6 then
  2012.                     nExtra := 6;
  2013.         end;
  2014.         GetRightParen;
  2015.         if token <> DoneT then begin
  2016.                 MakeLowerCase(PaletteType);
  2017.                 if pos('gray', PaletteType) <> 0 then
  2018.                     ResetGrayMap
  2019.                 else if pos('pseudo', PaletteType) <> 0 then
  2020.                     SwitchColorTables(Pseudo20Item, true)
  2021.                 else if pos('system', PaletteType) <> 0 then
  2022.                     SwitchColorTables(SystemPaletteItem, true)
  2023.                 else if pos('rainbow', PaletteType) <> 0 then
  2024.                     SwitchColorTables(RainbowItem, true)
  2025.                 else if pos('spectrum', PaletteType) <> 0 then
  2026.                     SwitchColorTables(SpectrumItem, true);
  2027.                 if OptionalArgument then begin
  2028.                     nExtraColors := nExtra;
  2029.                     RedrawLUTWindow;
  2030.                 end;
  2031.             end;
  2032.     end;
  2033.  
  2034.  
  2035.     procedure DoOpenImage;
  2036.         var
  2037.             err: OSErr;
  2038.             f: integer;
  2039.             FileFound, result: boolean;
  2040.             fname: str255;
  2041.             SaveCommand: CommandType;
  2042.     begin
  2043.         SaveCommand := MacroCommand;
  2044.         GetArguments(fname);
  2045.         if token <> DoneT then begin
  2046.                 if fname = '' then
  2047.                     fname := DefaultFileName;
  2048.                 err := fsopen(fname, DefaultRefNum, f);
  2049.                 FileFound := err = NoErr;
  2050.                 err := fsclose(f);
  2051.                 if FileFound then
  2052.                     case SaveCommand of
  2053.                         OpenC: 
  2054.                             result := DoOpen(fname, DefaultRefNum);
  2055.                         ImportC: 
  2056.                             result := ImportFile(fname, DefaultRefNum);
  2057.                     end
  2058.                 else
  2059.                     case SaveCommand of
  2060.                         OpenC: 
  2061.                             result := DoOpen('', 0);
  2062.                         ImportC: 
  2063.                             result := ImportFile('', 0);
  2064.                     end;
  2065.                 if result then
  2066.                     UpdatePicWindow
  2067.                 else
  2068.                     token := DoneT;
  2069.             end;
  2070.     end;
  2071.  
  2072.  
  2073.     procedure SetImportAttributes;
  2074.         var
  2075.             Attributes: str255;
  2076.     begin
  2077.         Attributes := GetStringArg;
  2078.         if Token <> DoneT then begin
  2079.                 MakeLowerCase(Attributes);
  2080.                 WhatToImport := ImportTIFF;
  2081.                 ImportCustomDepth := EightBits;
  2082.                 ImportSwapBytes := false;
  2083.                 ImportCalibrate := false;
  2084.                 ImportAll := false;
  2085.                 ImportAutoScale := true;
  2086.                 ImportInvert := false;
  2087.                 if pos('dicom', Attributes) <> 0 then
  2088.                     WhatToImport := ImportDICOM;
  2089.                 if pos('mcid', Attributes) <> 0 then
  2090.                     WhatToImport := ImportMCID;
  2091.                 if pos('look', Attributes) <> 0 then
  2092.                     WhatToImport := ImportLUT;
  2093.                 if pos('palette', Attributes) <> 0 then
  2094.                     WhatToImport := ImportLUT;
  2095.                 if pos('text', Attributes) <> 0 then
  2096.                     WhatToImport := ImportText;
  2097.                 if pos('custom', Attributes) <> 0 then
  2098.                     WhatToImport := ImportCustom;
  2099.                 if (pos('8', Attributes) <> 0) or (pos('eight', Attributes) <> 0) then begin
  2100.                         ImportCustomDepth := EightBits;
  2101.                         WhatToImport := ImportCustom;
  2102.                     end;
  2103.                 if (pos('signed', Attributes) <> 0) then begin
  2104.                         ImportCustomDepth := SixteenBitsSigned;
  2105.                         WhatToImport := ImportCustom;
  2106.                     end;
  2107.                 if (pos('unsigned', Attributes) <> 0) then begin
  2108.                         ImportCustomDepth := SixteenBitsUnsigned;
  2109.                         WhatToImport := ImportCustom;
  2110.                     end;
  2111.                 if (pos('swap', Attributes) <> 0) then
  2112.                     ImportSwapBytes := true;
  2113.                 if (pos('calibrate', Attributes) <> 0) then
  2114.                     ImportCalibrate := true;
  2115.                 if (pos('fixed', Attributes) <> 0) then
  2116.                     ImportAutoScale := false;
  2117.                 if (pos('all', Attributes) <> 0) then
  2118.                     ImportAll := true;
  2119.                 if (pos('invert', Attributes) <> 0) then
  2120.                     ImportInvert := true;
  2121.             end;
  2122.     end;
  2123.  
  2124.  
  2125.     procedure SetImportMinMax; {(min,max:integer)}
  2126.         var
  2127.             TempMin, TempMax: extended;
  2128.     begin
  2129.         GetLeftParen;
  2130.         TempMin := GetExpression;
  2131.         GetComma;
  2132.         TempMax := GetExpression;
  2133.         GetRightParen;
  2134.         if Token <> DoneT then begin
  2135.                 ImportAutoScale := false;
  2136.                 ImportMin := TempMin;
  2137.                 ImportMax := TempMax;
  2138.             end;
  2139.     end;
  2140.  
  2141.  
  2142.     procedure SetCustomImport; {(width,height,offset[,nslices]:integer)}
  2143.         var
  2144.             width, height, nSlices: integer;
  2145.             offset: LongInt;
  2146.     begin
  2147.         GetLeftParen;
  2148.         width := GetInteger;
  2149.         GetComma;
  2150.         height := GetInteger;
  2151.         GetComma;
  2152.         offset := GetInteger;
  2153.         GetToken;
  2154.         if token = comma then
  2155.             nSlices := GetInteger
  2156.         else begin
  2157.                 PutTokenBack;
  2158.                 nSlices := 1
  2159.             end;
  2160.         GetRightParen;
  2161.         if (width < 0) or (width > MaxPicSize) or (height < 0) or (offset < 0) or (nSlices < 1) then
  2162.             MacroError('Argument out of range');
  2163.         if Token <> DoneT then begin
  2164.                 ImportCustomWidth := width;
  2165.                 ImportCustomHeight := height;
  2166.                 ImportCustomOffset := offset;
  2167.                 ImportCustomSlices := nSlices;
  2168.                 WhatToImport := ImportCustom;
  2169.             end;
  2170.     end;
  2171.  
  2172.  
  2173.     procedure SelectImage (id: integer);
  2174.     begin
  2175.         StopDigitizing;
  2176.         SaveRoi;
  2177.         DisableDensitySlice;
  2178.         SelectWindow(PicWindow[id]);
  2179.         Info := pointer(WindowPeek(PicWindow[id])^.RefCon);
  2180.         ActivateWindow;
  2181.         GenerateValues;
  2182.         LoadLUT(info^.cTable);
  2183.         UpdatePicWindow;
  2184.     end;
  2185.  
  2186.  
  2187.     procedure SelectPic; {(PicN:integer)}
  2188.         var
  2189.             PicN, i: integer;
  2190.             SaveCommand: CommandType;
  2191.     begin
  2192.         SaveCommand := MacroCommand;
  2193.         GetLeftParen;
  2194.         PicN := GetInteger;
  2195.         GetRightParen;
  2196.         i := 0;
  2197.         while (PicN < 0) and (i < nPics) do begin
  2198.                 i := i + 1;
  2199.                 if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
  2200.                     PicN := i;
  2201.             end;
  2202.         if (PicN < 1) or (PicN > nPics) then
  2203.             MacroError('Specified image does not exist');
  2204.         if Token <> DoneT then begin
  2205.                 if SaveCommand = SelectPicC then
  2206.                     SelectImage(PicN)
  2207.                 else begin
  2208.                         StopDigitizing;
  2209.                         DisableDensitySlice;
  2210.                         Info := pointer(WindowPeek(PicWindow[PicN])^.RefCon);
  2211.                     end;
  2212.             end;
  2213.     end;
  2214.  
  2215.  
  2216.     procedure SetPicName;  {(name:string)}
  2217.         var
  2218.             n, i: LongInt;
  2219.             isInteger: boolean;
  2220.             name: str255;
  2221.     begin
  2222.         GetArguments(name);
  2223.         if Token <> DoneT then begin
  2224.                 with info^ do begin
  2225.                         title := name;
  2226.                         if PictureType <> FrameGrabberType then
  2227.                             PictureType := NewPicture;
  2228.                         UpdateWindowsMenuItem;
  2229.                         UpdateTitleBar;
  2230.                     end;
  2231.             end;
  2232.     end;
  2233.  
  2234.  
  2235.     procedure SetNewSize; {(width,height:integer)}
  2236.         var
  2237.             TempWidth, TempHeight: integer;
  2238.     begin
  2239.         GetLeftParen;
  2240.         TempWidth := GetInteger;
  2241.         GetComma;
  2242.         TempHeight := GetInteger;
  2243.         GetRightParen;
  2244.         if Token <> DoneT then begin
  2245.                 NewPicWidth := TempWidth;
  2246.                 NewPicHeight := TempHeight;
  2247.                 if NewPicWidth > MaxPicSize then
  2248.                     NewPicWidth := MaxPicSize;
  2249.                 if NewPicWidth < 8 then
  2250.                     NewPicWidth := 8;
  2251.                 if NewPicHeight < 8 then
  2252.                     NewPicHeight := 8;
  2253.                 if NewPicHeight > MaxPicSize then
  2254.                     NewPicHeight := MaxPicSize;
  2255.             end;
  2256.     end;
  2257.  
  2258.  
  2259.     procedure DoSaveAs;
  2260.         var
  2261.             name: str255;
  2262.             RefNum: integer;
  2263.             HasArgs: boolean;
  2264.     begin
  2265.         name := info^.title;
  2266.         if (name = 'Untitled') or (name = 'Camera') then
  2267.             name := '';
  2268.         GetToken;
  2269.         HasArgs := token = LeftParen;
  2270.         PutTokenBack;
  2271.         if HasArgs then
  2272.             GetArguments(name);
  2273.         if token <> DoneT then begin
  2274.                 StopDigitizing;
  2275.                 if nSaves = 0 then
  2276.                     RefNum := 0
  2277.                 else
  2278.                     RefNum := DefaultRefNum;
  2279.                 case CurrentWindow of
  2280.                     TextKind: 
  2281.                         if pos(':', name) <> 0 then
  2282.                             SaveTextUsingPath(name)
  2283.                         else
  2284.                             SaveTextAs;
  2285.                     ResultsKind: 
  2286.                         Export('', RefNum);
  2287.                     otherwise begin
  2288.                             if info <> NoInfo then
  2289.                                 SaveAs(name, RefNum)
  2290.                             else
  2291.                                 MacroError(NoImageOpen);
  2292.                         end;
  2293.                 end;
  2294.                 nSaves := nSaves + 1;
  2295.             end;
  2296.     end;
  2297.  
  2298.  
  2299.     procedure DoSave;
  2300.         var
  2301.             kind: integer;
  2302.     begin
  2303.         StopDigitizing;
  2304.         kind := CurrentWindow;
  2305.         if (kind = PicKind) or (kind = TextKind) or (Kind = ResultsKind) then
  2306.             SaveFile
  2307.         else
  2308.             MacroError('Nothing to save');
  2309.     end;
  2310.  
  2311.  
  2312.     procedure DoExport;
  2313.         var
  2314.             name: str255;
  2315.             RefNum: integer;
  2316.             HasArgs: boolean;
  2317.     begin
  2318.         StopDigitizing;
  2319.         name := info^.title;
  2320.         if (name = 'Untitled') or (name = 'Camera') then
  2321.             name := '';
  2322.         GetToken;
  2323.         HasArgs := token = LeftParen;
  2324.         PutTokenBack;
  2325.         if HasArgs then
  2326.             GetArguments(name);
  2327.         if nSaves = 0 then
  2328.             RefNum := 0
  2329.         else
  2330.             RefNum := DefaultRefNum;
  2331.         Export(name, RefNum);
  2332.         nSaves := nSaves + 1;
  2333.     end;
  2334.  
  2335.  
  2336.     procedure DoCopyResults;
  2337.         var
  2338.             IgnoreResult: boolean;
  2339.     begin
  2340.         if mCount < 1 then
  2341.             MacroError('Copy Results failed')
  2342.         else begin
  2343.                 CopyResults;
  2344.                 IgnoreResult := SystemEdit(3); {Fake Copy needed for MultiFinder}
  2345.             end;
  2346.     end;
  2347.  
  2348.  
  2349.     procedure DisposeAll;
  2350.         var
  2351.             i, ignore: integer;
  2352.     begin
  2353.         StopDigitizing;
  2354.         for i := nPics downto 1 do begin
  2355.                 Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2356.                 ignore := CloseAWindow(info^.wptr);
  2357.             end;
  2358.     end;
  2359.  
  2360.  
  2361.     procedure DoDuplicate;
  2362.         var
  2363.             str: str255;
  2364.     begin
  2365.         GetArguments(str);
  2366.         if token <> DoneT then
  2367.             if not Duplicate(str, false) then
  2368.                 token := DoneT
  2369.             else
  2370.                 UpdatePicWindow;
  2371.     end;
  2372.  
  2373.  
  2374.     procedure DoLineTo; {(x,y:integer)}
  2375.         var
  2376.             x, y: integer;
  2377.             p1, p2: point;
  2378.     begin
  2379.         GetLeftParen;
  2380.         p2.h := GetInteger;
  2381.         GetComma;
  2382.         p2.v := GetInteger;
  2383.         GetRightParen;
  2384.         if token <> DoneT then begin
  2385.                 KillRoi;
  2386.                 p1.h := CurrentX;
  2387.                 p1.v := CurrentY;
  2388.                 CurrentX := p2.h;
  2389.                 CurrentY := p2.v;
  2390.                 OffscreenToScreen(p1);
  2391.                 OffscreenToScreen(p2);
  2392.                 DrawObject(LineObj, p1, p2);
  2393.             end;
  2394.     end;
  2395.  
  2396.  
  2397.     procedure DoGetLine;  {(var x1,y1,x2,y2:real; LineWidth:integer)}
  2398.         var
  2399.             loc1, loc2, loc3, loc4, loc5: integer;
  2400.             x1, y1, x2, y2: extended;
  2401.     begin
  2402.         GetLeftParen;
  2403.         loc1 := GetVar;
  2404.         GetComma;
  2405.         loc2 := GetVar;
  2406.         GetComma;
  2407.         loc3 := GetVar;
  2408.         GetComma;
  2409.         loc4 := GetVar;
  2410.         GetComma;
  2411.         loc5 := GetVar;
  2412.         GetRightParen;
  2413.         if Token <> DoneT then
  2414.             with MacrosP^, info^ do begin
  2415.                     GetLoi(x1, y1, x2, y2);
  2416.                     if RoiShowing and (RoiType = LineRoi) then
  2417.                         stack[loc1].value := x1
  2418.                     else
  2419.                         stack[loc1].value := -1;
  2420.                     stack[loc2].value := y1;
  2421.                     stack[loc3].value := x2;
  2422.                     stack[loc4].value := y2;
  2423.                     stack[loc5].value := LineWidth;
  2424.                 end;
  2425.     end;
  2426.  
  2427.  
  2428.     procedure DoScaleAndRotate; {(hscale,vscale,angle:real)}
  2429.         var
  2430.             SaveCommand: CommandType;
  2431.     begin
  2432.         SaveCommand := MacroCommand;
  2433.         GetLeftParen;
  2434.         rsHScale := GetExpression;
  2435.         GetComma;
  2436.         rsVScale := GetExpression;
  2437.         if SaveCommand <> ScaleSelectionC then begin
  2438.                 GetComma;
  2439.                 rsAngle := GetExpression;
  2440.             end;
  2441.         GetRightParen;
  2442.         if token <> DoneT then begin
  2443.                 if SaveCommand = ScaleSelectionC then begin
  2444.                         rsMethod := NearestNeighbor;
  2445.                         rsCreateNewWindow := false;
  2446.                         rsAngle := 0.0;
  2447.                     end;
  2448.                 ScaleAndRotate;
  2449.             end;
  2450.     end;
  2451.  
  2452.  
  2453.     procedure SetPlotScale; {(min,max:integer)}
  2454.         var
  2455.             min, max: extended;
  2456.     begin
  2457.         GetLeftParen;
  2458.         min := GetExpression;
  2459.         GetComma;
  2460.         max := GetExpression;
  2461.         GetRightParen;
  2462.         if info^.fit = uncalibrated then begin
  2463.                 RangeCheck(trunc(min));
  2464.                 RangeCheck(trunc(max));
  2465.             end;
  2466.         if token <> DoneT then begin
  2467.                 AutoScalePlots := (min = 0.0) and (max = 0.0);
  2468.                 ProfilePlotMin := min;
  2469.                 ProfilePlotMax := max;
  2470.             end;
  2471.     end;
  2472.  
  2473.  
  2474.     procedure SetPlotDimensions; {(width,height:integer)}
  2475.         var
  2476.             width, height: integer;
  2477.     begin
  2478.         GetLeftParen;
  2479.         width := GetInteger;
  2480.         GetComma;
  2481.         height := GetInteger;
  2482.         GetRightParen;
  2483.         if token <> DoneT then begin
  2484.                 FixedSizePlot := not ((width = 0) and (height = 0));
  2485.                 ProfilePlotWidth := width;
  2486.                 ProfilePlotHeight := height;
  2487.             end;
  2488.     end;
  2489.  
  2490.  
  2491.     procedure GetResults;  {(var n,mean,mode,min,max:real)}
  2492.         var
  2493.             loc1, loc2, loc3, loc4, loc5: integer;
  2494.     begin
  2495.         GetLeftParen;
  2496.         loc1 := GetVar;
  2497.         GetComma;
  2498.         loc2 := GetVar;
  2499.         GetComma;
  2500.         loc3 := GetVar;
  2501.         GetComma;
  2502.         loc4 := GetVar;
  2503.         GetComma;
  2504.         loc5 := GetVar;
  2505.         GetRightParen;
  2506.         if mCount = 0 then
  2507.             MacroError('No results');
  2508.         if Token <> DoneT then
  2509.             with MacrosP^, results do begin
  2510.                     stack[loc1].value := PixelCount^[mCount];
  2511.                     stack[loc2].value := UncalibratedMean;
  2512.                     stack[loc3].value := imode;
  2513.                     stack[loc4].value := MinIndex;
  2514.                     stack[loc5].value := MaxIndex;
  2515.                 end;
  2516.     end;
  2517.  
  2518.  
  2519.     procedure DoPasteOperation;
  2520.     begin
  2521.         if not (OpPending and (CurrentOp = PasteOp)) then begin
  2522.                 MacroError('Not pasting');
  2523.                 exit(DoPasteOperation);
  2524.             end;
  2525.         if MacroCommand in [AddC, SubC, MulC, DivC] then begin
  2526.                 case MacroCommand of
  2527.                     AddC: 
  2528.                         CurrentOp := AddOp;
  2529.                     SubC: 
  2530.                         CurrentOp := SubtractOp;
  2531.                     MulC: 
  2532.                         CurrentOp := MultiplyOp;
  2533.                     DivC: 
  2534.                         CurrentOp := DivideOp;
  2535.                 end;
  2536.                 DoPasteMath;
  2537.                 exit(DoPasteOperation);
  2538.             end;
  2539.         SetForegroundColor(BlackIndex);
  2540.         SetBackGroundColor(WhiteIndex);
  2541.         case MacroCommand of
  2542.             CopyModeC: 
  2543.                 SetPasteMode(CopyModeItem);
  2544.             AndC: 
  2545.                 SetPasteMode(AndItem);
  2546.             OrC: 
  2547.                 SetPasteMode(OrItem);
  2548.             XorC: 
  2549.                 SetPasteMode(XorItem);
  2550.             ReplaceC: 
  2551.                 SetPasteMode(ReplaceItem);
  2552.             BlendC: 
  2553.                 SetPasteMode(BlendItem);
  2554.         end;
  2555.         if OptionKeyWasDown then begin
  2556.                 if PasteControl <> nil then
  2557.                     DrawPasteControl;
  2558.             end
  2559.         else
  2560.             KillRoi;
  2561.     end;
  2562.  
  2563.  
  2564.     procedure SetWidth; {(width:integer)}
  2565.         var
  2566.             width: integer;
  2567.     begin
  2568.         GetLeftParen;
  2569.         width := GetInteger;
  2570.         GetRightParen;
  2571.         if (Token <> DoneT) and (width > 0) then begin
  2572.                 LineWidth := width;
  2573.                 ShowLIneWidth;
  2574.             end;
  2575.     end;
  2576.  
  2577.  
  2578.     function GetMType (index: integer): MeasurementTypes;
  2579.     begin
  2580.         case index of
  2581.             0: 
  2582.                 GetMType := AreaM;
  2583.             1: 
  2584.                 GetMType := MeanM;
  2585.             2: 
  2586.                 GetMType := StdDevM;
  2587.             3: 
  2588.                 GetMType := xyLocM;
  2589.             4: 
  2590.                 GetMType := ModeM;
  2591.             5: 
  2592.                 GetMType := LengthM;
  2593.             6: 
  2594.                 GetMType := MajorAxisM;
  2595.             7: 
  2596.                 GetMType := MinorAxisM;
  2597.             8: 
  2598.                 GetMType := AngleM;
  2599.             9: 
  2600.                 GetMType := IntDenM;
  2601.             10: 
  2602.                 GetMType := MinMaxM;
  2603.             11: 
  2604.                 GetMType := User1M;
  2605.             12: 
  2606.                 GetMType := User2M;
  2607.         end;
  2608.     end;
  2609.  
  2610.  
  2611.     procedure SetPrecision; {(DigitsRightofDecimalPoint[,FieldWidth]:integer)}
  2612.         var
  2613.             digits, width: LongInt;
  2614.     begin
  2615.         GetLeftParen;
  2616.         digits := GetInteger;
  2617.         GetToken;
  2618.         if token = comma then
  2619.             width := GetInteger
  2620.         else
  2621.             PutTokenBack;
  2622.         GetRightParen;
  2623.         if Token <> DoneT then begin
  2624.                 if (digits >= 0) and (digits <= 12) then
  2625.                     precision := digits;
  2626.                 if (width >= 1) and (width <= 18) then
  2627.                     FieldWidth := width;
  2628.             end;
  2629.     end;
  2630.  
  2631.  
  2632.     procedure SetParticleSize; {(min,max:LongInt)}
  2633.         var
  2634.             min, max: LongInt;
  2635.     begin
  2636.         GetLeftParen;
  2637.         min := GetInteger;
  2638.         GetComma;
  2639.         max := GetInteger;
  2640.         GetRightParen;
  2641.         if Token <> DoneT then begin
  2642.                 MinParticleSize := min;
  2643.                 MaxParticleSize := max;
  2644.             end;
  2645.     end;
  2646.  
  2647.  
  2648.     procedure SetThreshold; {(level:integer)}
  2649.         var
  2650.             level: LongInt;
  2651.     begin
  2652.         GetLeftParen;
  2653.         level := GetInteger;
  2654.         GetRightParen;
  2655.         if level = -1 then begin
  2656.                 DisableThresholding;
  2657.                 exit(SetThreshold);
  2658.             end;
  2659.         RangeCheck(level);
  2660.         if Token <> DoneT then
  2661.             EnableThresholding(level);
  2662.     end;
  2663.  
  2664.  
  2665.     procedure DoPutPixel; {(hloc,vloc, value:integer)}
  2666.         var
  2667.             hloc, vloc: LongInt;
  2668.             value: integer;
  2669.             MaskRect: rect;
  2670.     begin
  2671.         GetLeftParen;
  2672.         hloc := GetInteger;
  2673.         GetComma;
  2674.         vloc := GetInteger;
  2675.         GetComma;
  2676.         value := GetInteger;
  2677.         GetRightParen;
  2678.         if (Token <> DoneT) and (info <> NoInfo) then begin
  2679.                 KillRoi;
  2680.                 PutPixel(hloc, vloc, value);
  2681.                 SetRect(MaskRect, hloc, vloc, hloc + 1, vloc + 1);
  2682.                 UpdateScreen(MaskRect);
  2683.                 info^.changes := true;
  2684.             end;
  2685.     end;
  2686.  
  2687.  
  2688.     procedure CloseWindow;
  2689.         var
  2690.             OldPicNum, NewPicNum, ignore: integer;
  2691.     begin
  2692.         if CurrentWindow <> PicKind then begin
  2693.                 ignore := CloseAWindow(CurrentWPtr);
  2694.                 exit(CloseWindow);
  2695.             end;
  2696.         if info = NoInfo then begin
  2697.                 MacroError(NoImageOpen);
  2698.                 exit(CloseWindow);
  2699.             end;
  2700.         StopDigitizing;
  2701.         SaveRoi;
  2702.         with info^ do begin
  2703.                 OldPicNum := PicNum;
  2704.                 ignore := CloseAWindow(wptr);
  2705.             end;
  2706.         if nPics >= 1 then begin
  2707.                 NewPicNum := OldPicNum - 1;
  2708.                 if NewPicNum < 1 then
  2709.                     NewPicNum := 1;
  2710.                 SelectImage(NewPicNum);
  2711.             end;
  2712.     end;
  2713.  
  2714.  
  2715.     procedure SetScaling;
  2716.         var
  2717.             ScalingOptions: str255;
  2718.             ok: boolean;
  2719.     begin
  2720.         ScalingOptions := GetStringArg;
  2721.         if token <> DoneT then begin
  2722.                 MakeLowerCase(ScalingOptions);
  2723.                 rsInteractive := false;
  2724.                 if pos('bilinear', ScalingOptions) <> 0 then
  2725.                     rsMethod := Bilinear;
  2726.                 if pos('nearest', ScalingOptions) <> 0 then
  2727.                     rsMethod := NearestNeighbor;
  2728.                 if pos('new', ScalingOptions) <> 0 then
  2729.                     rsCreateNewWindow := true;
  2730.                 if pos('same', ScalingOptions) <> 0 then
  2731.                     rsCreateNewWindow := false;
  2732.                 if pos('interactive', ScalingOptions) <> 0 then
  2733.                     rsInteractive := true;
  2734.             end;
  2735.     end;
  2736.  
  2737.  
  2738.     procedure DoChangeValues; {(v1,v2,v3:integer)}
  2739.         var
  2740.             v1, v2, v3: integer;
  2741.     begin
  2742.         GetLeftParen;
  2743.         v1 := GetInteger;
  2744.         GetComma;
  2745.         v2 := GetInteger;
  2746.         GetComma;
  2747.         v3 := GetInteger;
  2748.         GetRightParen;
  2749.         RangeCheck(v1);
  2750.         RangeCheck(v2);
  2751.         RangeCheck(v3);
  2752.         if Token <> DoneT then
  2753.             ChangeValues(v1, v2, v3);
  2754.     end;
  2755.  
  2756.  
  2757.     procedure DoGetMouse;  {(var x,y:integer)}
  2758.         var
  2759.             loc1, loc2, sh, sv: integer;
  2760.             loc: point;
  2761.     begin
  2762.         GetLeftParen;
  2763.         loc1 := GetVar;
  2764.         GetComma;
  2765.         loc2 := GetVar;
  2766.         GetRightParen;
  2767.         if Token <> DoneT then
  2768.             with MacrosP^ do begin
  2769.                     SetPort(info^.wptr);
  2770.                     GetMouse(loc);
  2771.                     with loc do begin
  2772.                             sh := h;
  2773.                             sv := v;
  2774.                             ScreenToOffscreen(loc);
  2775.                             if sh < 0 then
  2776.                                 h := sh;
  2777.                             if sv < 0 then
  2778.                                 v := sv;
  2779.                             stack[loc1].value := h;
  2780.                             stack[loc2].value := v;
  2781.                         end;
  2782.                 end;
  2783.     end;
  2784.  
  2785.  
  2786.     procedure DoRotate (cmd: CommandType);
  2787.         var
  2788.             NoBoolean, NewWindow: boolean;
  2789.     begin
  2790.         GetToken;
  2791.         noBoolean := token <> LeftParen;
  2792.         PutTokenBack;
  2793.         if NoBoolean then
  2794.             NewWindow := false
  2795.         else
  2796.             NewWindow := GetBooleanArg;
  2797.         if NewWindow then begin
  2798.                 case cmd of
  2799.                     RotateRC: 
  2800.                         RotateToNewWindow(RotateRight);
  2801.                     RotateLC: 
  2802.                         RotateToNewWindow(RotateLeft)
  2803.                 end;
  2804.                 if not macro then
  2805.                     MacroError('Rotate failed')
  2806.             end
  2807.         else
  2808.             case cmd of
  2809.                 RotateRC: 
  2810.                     FlipOrRotate(RotateRight);
  2811.                 RotateLC: 
  2812.                     FlipOrRotate(RotateLeft)
  2813.             end;
  2814.     end;
  2815.  
  2816.  
  2817.     procedure DoSelectSlice; {(SliceNumber:integer)}
  2818.         var
  2819.             SliceNumber: LongInt;
  2820.             isRoi: boolean;
  2821.             SaveCommand: CommandType;
  2822.     begin
  2823.         SaveCommand := MacroCommand;
  2824.         GetLeftParen;
  2825.         SliceNumber := GetInteger;
  2826.         GetRightParen;
  2827.         with info^, info^.StackInfo^ do begin
  2828.                 if (SliceNumber < 1) or (SliceNumber > nSlices) then
  2829.                     MacroError('Illegal slice number');
  2830.                 if Token <> DoneT then begin
  2831.                         isRoi := RoiShowing;
  2832.                         if isRoi then
  2833.                             KillRoi;
  2834.                         CurrentSlice := SliceNumber;
  2835.                         SelectSlice(CurrentSlice);
  2836.                         if SaveCommand = SelectSliceC then begin
  2837.                                 UpdatePicWindow;
  2838.                                 UpdateTitleBar;
  2839.                             end;
  2840.                         if isRoi then
  2841.                             RestoreRoi;
  2842.                     end;
  2843.             end;
  2844.     end;
  2845.  
  2846.  
  2847.     procedure MakeNewStack; {(name:str255)}
  2848.         var
  2849.             name: str255;
  2850.             aok: boolean;
  2851.     begin
  2852.         GetArguments(name);
  2853.         if token <> DoneT then
  2854.             if (NewPicWidth * NewPicHeight) > UndoBufSize then
  2855.                 MacroError('Stack larger than Undo Buffer')
  2856.             else if NewPicWindow(name, NewPicWidth, NewPicHeight) then
  2857.                 if not MakeStackFromWindow then
  2858.                     MacroError('Out of memory');
  2859.     end;
  2860.  
  2861.  
  2862.     procedure MakeLineRoi; {(x1,y1,x2,y2:real)}
  2863.         var
  2864.             x1, y1, x2, y2: extended;
  2865.     begin
  2866.         GetLeftParen;
  2867.         x1 := GetExpression;
  2868.         GetComma;
  2869.         y1 := GetExpression;
  2870.         GetComma;
  2871.         x2 := GetExpression;
  2872.         GetComma;
  2873.         y2 := GetExpression;
  2874.         GetRightParen;
  2875.         if token <> DoneT then
  2876.             with Info^ do begin
  2877.                     KillRoi;
  2878.                     StopDigitizing;
  2879.                     LX1 := x1;
  2880.                     LY1 := y1;
  2881.                     LX2 := x2;
  2882.                     LY2 := y2;
  2883.                     RoiType := LineRoi;
  2884.                     MakeRegion;
  2885.                     SetupUndo;
  2886.                     RoiShowing := true;
  2887.                 end;
  2888.     end;
  2889.  
  2890.  
  2891.     procedure DoGetTime;
  2892.         var
  2893.             date: DateTimeRec;
  2894.             loc1, loc2, loc3, loc4, loc5, loc6, loc7: integer;
  2895.     begin
  2896.         GetLeftParen;
  2897.         loc1 := GetVar;
  2898.         GetComma;
  2899.         loc2 := GetVar;
  2900.         GetComma;
  2901.         loc3 := GetVar;
  2902.         GetComma;
  2903.         loc4 := GetVar;
  2904.         GetComma;
  2905.         loc5 := GetVar;
  2906.         GetComma;
  2907.         loc6 := GetVar;
  2908.         GetComma;
  2909.         loc7 := GetVar;
  2910.         GetRightParen;
  2911.         if Token <> DoneT then
  2912.             with MacrosP^, info^ do begin
  2913.                     GetTime(date);
  2914.                     with date do begin
  2915.                             stack[loc1].value := year;
  2916.                             stack[loc2].value := month;
  2917.                             stack[loc3].value := day;
  2918.                             stack[loc4].value := hour;
  2919.                             stack[loc5].value := minute;
  2920.                             stack[loc6].value := second;
  2921.                             stack[loc7].value := DayOfWeek;
  2922.                         end;
  2923.                 end;
  2924.     end;
  2925.  
  2926.  
  2927.     function GetStringVar: integer;
  2928.     begin
  2929.         GetStringVar := 0;
  2930.         GetToken;
  2931.         if token <> StringVariable then
  2932.             MacroError('String variable expected')
  2933.         else
  2934.             GetStringVar := TokenStackLoc;
  2935.     end;
  2936.  
  2937.  
  2938.     procedure DoSetScale; {(scale:real; unit:string; [AspectRatio: real])}
  2939.         var
  2940.             id: integer;
  2941.             scale, AspectRatio: extended;
  2942.             str: str255;
  2943.     begin
  2944.         AspectRatio:=0.0;
  2945.         GetLeftParen;
  2946.         scale := GetExpression;
  2947.         GetComma;
  2948.         str := GetString;
  2949.         GetToken;
  2950.         if token=comma
  2951.             then AspectRatio:=GetExpression
  2952.             else PutTokenBack;
  2953.         GetRightParen;
  2954.         if token <> DoneT then
  2955.             with info^ do begin
  2956.                     if str = '' then begin
  2957.                             SetScale; {Display Set Scale dialog box}
  2958.                             exit(DoSetScale);
  2959.                         end;
  2960.                     if scale < 0.0 then begin
  2961.                             MacroError('Scale<0');
  2962.                             exit(DoSetScale);
  2963.                         end;
  2964.                     MakeLowerCase(str);
  2965.                     TruncateString(str, maxUnit);
  2966.                     xUnit := str;
  2967.                     xScale := scale;
  2968.                     yScale := scale;
  2969.                     if AspectRatio>0.0 then begin
  2970.                         PixelAspectRatio:=AspectRatio;
  2971.                         yScale := xScale / PixelAspectRatio;
  2972.                     end else
  2973.                         PixelAspectRatio := 1.0;
  2974.                     SpatiallyCalibrated := (xUnit <> '') and (xUnit <> 'pixel') and (xUnit <> 'pixels') and (xScale <> 0.0);
  2975.                     UpdateTitleBar;
  2976.                 end;
  2977.     end;
  2978.  
  2979.  
  2980.     procedure GetScale;  {(var scale:real; unit:string; [AspectRatio:real])}
  2981.         var
  2982.             loc1, loc2, loc3, index, count: integer;
  2983.             str: str255;
  2984.     begin
  2985.         GetLeftParen;
  2986.         loc1 := GetVar;
  2987.         GetComma;
  2988.         loc2 := GetStringVar;
  2989.         loc3:=0;
  2990.         GetToken;
  2991.         if token=comma
  2992.          then loc3 := GetVar
  2993.          else PutTokenBack;
  2994.         GetRightParen;
  2995.         if Token <> DoneT then
  2996.             with info^, MacrosP^ do
  2997.                 if SpatiallyCalibrated then begin
  2998.                         stack[loc1].value := xScale;
  2999.                         stack[loc2].StringH^^ := xUnit;
  3000.                         if loc3>0 then stack[loc3].value := PixelAspectRatio;
  3001.                     end
  3002.                 else begin
  3003.                         stack[loc1].value := 1.0;
  3004.                         stack[loc2].StringH^^ := 'pixel';
  3005.                         if loc3>0 then stack[loc3].value := 1.0;
  3006.                     end;
  3007.     end;
  3008.  
  3009.  
  3010.     procedure SaveState;
  3011.     begin
  3012.         SaveForeground := ForegroundIndex;
  3013.         SaveBackground := BackgroundIndex;
  3014.         SavePicWidth := NewPicWidth;
  3015.         SavePicHeight := NewPicHeight;
  3016.         SaveMethod := rsMethod;
  3017.         SaveCreate := rsCreateNewWindow;
  3018.         SaveAngle := rsAngle;
  3019.         SaveH := rsHScale;
  3020.         SaveV := rsVScale;
  3021.         SaveInvertY := InvertYCoordinates;
  3022.         SaveScaleArithmetic := ScaleArithmetic;
  3023.         SaveScaleConvolutions := ScaleConvolutions;
  3024.         SaveCurrentFontID:=CurrentFontID;
  3025.         SaveCurrentSize:=CurrentSize;
  3026.         SaveCurrentStyle:=CurrentStyle;
  3027.         SaveTextJust:=TextJust;
  3028.         SaveTextBack:=TextBack;
  3029.     end;
  3030.  
  3031.  
  3032.     procedure RestoreState;
  3033.     begin
  3034.         if SaveForeground = -1 then
  3035.             MacroError('State not saved')
  3036.         else begin
  3037.                 SetForegroundColor(SaveForeground);
  3038.                 SetBackgroundColor(SaveBackground);
  3039.                 NewPicWidth := SavePicWidth;
  3040.                 NewPicHeight := SavePicHeight;
  3041.                 rsMethod := SaveMethod;
  3042.                 rsCreateNewWindow := SaveCreate;
  3043.                 rsAngle := SaveAngle;
  3044.                 rsHScale := SaveH;
  3045.                 rsVScale := SaveV;
  3046.                 InvertYCoordinates := SaveInvertY;
  3047.                 ScaleArithmetic := SaveScaleArithmetic;
  3048.                 ScaleConvolutions := SaveScaleConvolutions;
  3049.                 CurrentFontID:=SaveCurrentFontID;
  3050.                 CurrentSize:=SaveCurrentSize;
  3051.                 CurrentStyle:=SaveCurrentStyle;
  3052.                 TextJust:=SaveTextJust;
  3053.                 TextBack:=SaveTextBack;
  3054. end;
  3055.     end;
  3056.  
  3057.  
  3058.     procedure DoPrint;
  3059.     begin
  3060.         FindWhatToPrint;
  3061.         if WhatToPrint <> NothingToPrint then
  3062.             Print(false)
  3063.         else
  3064.             MacroError('NothingToPrint');
  3065.     end;
  3066.  
  3067.  
  3068.     procedure SetCounter; {(n:integer)}
  3069.         var
  3070.             N, i: LongInt;
  3071.     begin
  3072.         GetLeftParen;
  3073.         N := GetInteger;
  3074.         GetRightParen;
  3075.         if (N < 0) or (N > MaxMeasurements) then
  3076.             MacroError('Argument out of range');
  3077.         if Token <> DoneT then begin
  3078.                 if N = 0 then
  3079.                     ResetCounter;
  3080.                 for i := mCount + 1 to N do
  3081.                     ClearResults(i);
  3082.                 mCount := N;
  3083.                 UpdateList;
  3084.                 ShowInfo;
  3085.             end;
  3086.     end;
  3087.  
  3088.  
  3089.     procedure OutputText;
  3090.         var
  3091.             NewLine: boolean;
  3092.             str: str255;
  3093.             i: integer;
  3094.             SaveCommand: CommandType;
  3095.     begin
  3096.         NewLine := MacroCommand <> WriteC;
  3097.         SaveCommand := MacroCommand;
  3098.         GetArguments(str);
  3099.         if token <> DoneT then begin
  3100.                 if SaveCommand = ShowMsgC then begin
  3101.                         for i := 1 to length(str) do
  3102.                             if str[i] = '\' then
  3103.                                 str[i] := cr;
  3104.                         InfoMessage := str;
  3105.                         ShowInfo;
  3106.                     end
  3107.                 else begin
  3108.                         if CurrentWindow = TextKind then begin
  3109.                             InsertText(str, NewLine);
  3110.                             if not macro then MacroError('32K text limit exceeded')
  3111.                         end else
  3112.                             DoDrawText(str, NewLine);
  3113.                     end;
  3114.             end;
  3115.     end;
  3116.  
  3117.  
  3118.     procedure SetErosionDilationCount; {(n:integer)}
  3119.         var
  3120.             n: LongInt;
  3121.     begin
  3122.         GetLeftParen;
  3123.         n := GetInteger;
  3124.         GetRightParen;
  3125.         if (n < 1) or (n > 8) then
  3126.             MacroError('Argument out of range');
  3127.         if Token <> DoneT then begin
  3128.                 BinaryCount := n;
  3129.                 BinaryThreshold := BinaryCount * 255;
  3130.             end;
  3131.     end;
  3132.  
  3133.  
  3134.     procedure SetSliceSpacing; {(n:real)}
  3135.         var
  3136.             n: extended; {pixels}
  3137.     begin
  3138.         GetLeftParen;
  3139.         n := GetExpression;
  3140.         GetRightParen;
  3141.         if (n <= 0.0) or (n > 100.0) then
  3142.             MacroError('Argument out of range');
  3143.         if info^.StackInfo = nil then
  3144.             MacroError('No stack');
  3145.         if Token <> DoneT then
  3146.             info^.StackInfo^.SliceSpacing := n;
  3147.     end;
  3148.  
  3149.  
  3150.     procedure GetOrPutLineOrColumn;  {(x,y,count:integer:integer)}
  3151.         var
  3152.             x, y, count, i: integer;
  3153.             MaskRect: rect;
  3154.             aLine2: LineType;
  3155.             SaveCommand: CommandType;
  3156.     begin
  3157.         SaveCommand := MacroCommand;
  3158.         GetLeftParen;
  3159.         x := GetInteger;
  3160.         GetComma;
  3161.         y := GetInteger;
  3162.         GetComma;
  3163.         count := GetInteger;
  3164.         GetRightParen;
  3165.         if (Token <> DoneT) and (count <= MaxLine) then
  3166.             with MacrosP^ do begin
  3167.                     KillRoi;
  3168.                     case SaveCommand of
  3169.                         GetRowC: 
  3170.                             GetLine(x, y, count, aLine);
  3171.                         PutRowC:  begin
  3172.                                 PutLine(x, y, count, aLine);
  3173.                                 SetRect(MaskRect, x, y, x + count, y + 1);
  3174.                                 UpdateScreen(MaskRect);
  3175.                                 info^.changes := true;
  3176.                             end;
  3177.                         GetColumnC: 
  3178.                             GetColumn(x, y, count, aLine);
  3179.                         PutColumnC:  begin
  3180.                                 PutColumn(x, y, count, aLine);
  3181.                                 SetRect(MaskRect, x, y, x + 1, y + count);
  3182.                                 UpdateScreen(MaskRect);
  3183.                                 info^.changes := true;
  3184.                             end;
  3185.                     end; {case}
  3186.                 end;
  3187.     end;
  3188.  
  3189.  
  3190.     procedure CheckVersion; {(RequiredVersion:real)}
  3191.         var
  3192.             RequiredVersion: extended;
  3193.             str: str255;
  3194.     begin
  3195.         GetLeftParen;
  3196.         RequiredVersion := GetExpression;
  3197.         GetRightParen;
  3198.         if (Token <> DoneT) then
  3199.             if round(RequiredVersion * 100.0) > version then begin
  3200.                     RealToString(RequiredVersion, 1, 2, str);
  3201.                     PutError(concat('This macro requires version ', str, ' or later of NIH Image.'));
  3202.                     Token := DoneT;
  3203.                 end;
  3204.     end;
  3205.  
  3206.  
  3207.     procedure SetOptions; {(Options:string)}
  3208.         var
  3209.             options: str255;
  3210.             mtype: MeasurementTypes;
  3211.             i, LastOption: integer;
  3212.             SaveMeasurements: SetOfMeasurements;
  3213.     begin
  3214.         GetLeftParen;
  3215.         Options := GetString;
  3216.         GetRightParen;
  3217.         if (Token <> DoneT) then begin
  3218.                 SaveMeasurements := measurements;
  3219.                 MakeLowerCase(options);
  3220.                 Measurements := [];
  3221.                 if pos('area', options) <> 0 then
  3222.                     Measurements := Measurements + [AreaM];
  3223.                 if pos('mean', options) <> 0 then
  3224.                     Measurements := Measurements + [MeanM];
  3225.                 if pos('st', options) <> 0 then
  3226.                     Measurements := Measurements + [StdDevM];
  3227.                 if pos('center', options) <> 0 then
  3228.                     Measurements := Measurements + [xyLocM];
  3229.                 if pos('mode', options) <> 0 then
  3230.                     Measurements := Measurements + [ModeM];
  3231.                 if (pos('per', options) <> 0) or (pos('length', options) <> 0) then
  3232.                     Measurements := Measurements + [LengthM];
  3233.                 if pos('major', options) <> 0 then
  3234.                     Measurements := Measurements + [MajorAxisM];
  3235.                 if pos('minor', options) <> 0 then
  3236.                     Measurements := Measurements + [MinorAxisM];
  3237.                 if pos('angle', options) <> 0 then
  3238.                     Measurements := Measurements + [AngleM];
  3239.                 if pos('int', options) <> 0 then
  3240.                     Measurements := Measurements + [IntDenM];
  3241.                 if pos('max', options) <> 0 then
  3242.                     Measurements := Measurements + [MinMaxM];
  3243.                 if pos('1', options) <> 0 then
  3244.                     Measurements := Measurements + [User1M];
  3245.                 if pos('2', options) <> 0 then
  3246.                     Measurements := Measurements + [User2M];
  3247.                 UpdateFitEllipse;
  3248.                 if Measurements <> SaveMeasurements then
  3249.                     UpdateList;
  3250.             end;
  3251.     end;
  3252.  
  3253.  
  3254.     procedure SetLabel;
  3255.         var
  3256.             SaveCommand: CommandType;
  3257.             str, SaveLabel: str255;
  3258.     begin
  3259.         SaveCommand := MacroCommand;
  3260.         GetArguments(str);
  3261.         TruncateString(str, maxLabelLength);
  3262.         case SaveCommand of
  3263.             SetMajorC:  begin
  3264.                     SaveLabel := MajorLabel;
  3265.                     MajorLabel := str;
  3266.                     Measurements := Measurements + [MajorAxisM];
  3267.                 end;
  3268.             SetMinorC:  begin
  3269.                     SaveLabel := MinorLabel;
  3270.                     MinorLabel := str;
  3271.                     Measurements := Measurements + [MinorAxisM];
  3272.                 end;
  3273.             SetUser1C:  begin
  3274.                     SaveLabel := User1Label;
  3275.                     User1Label := str;
  3276.                     Measurements := Measurements + [User1M];
  3277.                 end;
  3278.             SetUser2C:  begin
  3279.                     SaveLabel := User2Label;
  3280.                     User2Label := str;
  3281.                     Measurements := Measurements + [User2M];
  3282.                 end;
  3283.         end; {case}
  3284.         ShowInfo;
  3285.         if str <> SaveLabel then
  3286.             UpdateList;
  3287.     end;
  3288.  
  3289.  
  3290.     procedure DoUpdateLUT;
  3291.     begin
  3292.         with info^ do begin
  3293.                 LoadLUT(ctable);
  3294.                 IdentityFunction := false;
  3295.                 if isGrayScaleLUT then
  3296.                     LutMode := CustomGrayScale
  3297.                 else begin
  3298.                         SetupPseudocolor;
  3299.                         LutMode := PseudoColor;
  3300.                     end;
  3301.                 UpdateMap;
  3302.             if ScreenDepth<>8 then
  3303.                  UpdatePicWindow;
  3304.             end;
  3305.     end;
  3306.  
  3307.  
  3308.     procedure SubtractBackground; {(Options:string; BallRadius:integer)}
  3309.         var
  3310.             options: str255;
  3311.             radius, item: integer;
  3312.     begin
  3313.         GetLeftParen;
  3314.         Options := GetString;
  3315.         GetComma;
  3316.         radius := GetInteger;
  3317.         GetRightParen;
  3318.         if (Token <> DoneT) then begin
  3319.                 MakeLowerCase(options);
  3320.                 FasterBackgroundSubtraction := pos('faster', options) <> 0;
  3321.                 item := Sub2DItem;
  3322.                 if pos('hor', options) <> 0 then
  3323.                     item := HorizontalItem;
  3324.                 if pos('ver', options) <> 0 then
  3325.                     item := VerticalItem;
  3326.                 if pos('roll', options) <> 0 then
  3327.                     item := Sub2DItem;
  3328.                 if pos('remove', options) <> 0 then
  3329.                     item := RemoveStreaksItem;
  3330.             end;
  3331.         BallRadius := Radius;
  3332.         if Radius < 1 then
  3333.             BallRadius := 1;
  3334.         if Radius > 319 then
  3335.             BallRadius := 319;
  3336.         DoBackgroundMenuEvent(Item);
  3337.     end;
  3338.  
  3339.  
  3340.     procedure SetExportMode;
  3341.         var
  3342.             mode: str255;
  3343.     begin
  3344.         mode := GetStringArg;
  3345.         if Token <> DoneT then begin
  3346.                 MakeLowerCase(mode);
  3347.                 ExportAsWhat := AsRaw;
  3348.                 if pos('mcid', mode) <> 0 then
  3349.                     ExportAsWhat := asMCID;
  3350.                 if pos('text', mode) <> 0 then
  3351.                     ExportAsWhat := asText;
  3352.                 if pos('lut', mode) <> 0 then
  3353.                     ExportAsWhat := asLUT;
  3354.                 if pos('meas', mode) <> 0 then
  3355.                     ExportAsWhat := asMeasurements;
  3356.                 if pos('plot', mode) <> 0 then
  3357.                     ExportAsWhat := asPlotValues;
  3358.                 if pos('hist', mode) <> 0 then
  3359.                     ExportAsWhat := asHistogramValues;
  3360.                 if pos('xy', mode) <> 0 then
  3361.                     ExportAsWhat := asCoordinates;
  3362.             end;
  3363.     end;
  3364.  
  3365.  
  3366.     procedure SetSaveAsMode;
  3367.         var
  3368.             mode: str255;
  3369.     begin
  3370.         mode := GetStringArg;
  3371.         if Token <> DoneT then begin
  3372.                 MakeLowerCase(mode);
  3373.                 SaveAsWhat := asTiff;
  3374.                 if pos('tiff', mode) <> 0 then
  3375.                     SaveAsWhat := asTiff;
  3376.                 if pos('pict', mode) <> 0 then
  3377.                     SaveAsWhat := asPict;
  3378.                 if pos('paint', mode) <> 0 then
  3379.                     SaveAsWhat := asMacPaint;
  3380.                 if pos('pics', mode) <> 0 then
  3381.                     SaveAsWhat := asPICS;
  3382.                 if pos('lut', mode) <> 0 then
  3383.                     SaveAsWhat := AsPalette;
  3384.                 if pos('outline', mode) <> 0 then
  3385.                     SaveAsWhat := AsOutline;
  3386.                 if pos('rgb', mode) <> 0 then with info^ do begin
  3387.                     if StackInfo = nil then begin
  3388.                         MacroError('Stack required');
  3389.                         exit(SetSaveAsMode);
  3390.                     end;
  3391.                     if StackInfo^.nSlices <> 3 then begin
  3392.                         MacroError('Stack must have 3 slices');
  3393.                         exit(SetSaveAsMode);
  3394.                     end;
  3395.                     StackInfo^.StackType := rgbStack;
  3396.                     UpdateTitleBar;
  3397.                 end;
  3398.             end;
  3399.     end;
  3400.  
  3401.  
  3402.     procedure MoveCurrentWindow;{(x,y:integer)}
  3403.         var
  3404.             x, y: integer;
  3405.             ignore: integer;
  3406.             fwptr: WindowPtr;
  3407.             kind: integer;
  3408.     begin
  3409.         GetLeftParen;
  3410.         x := GetInteger;
  3411.         GetComma;
  3412.         y := GetInteger;
  3413.         GetRightParen;
  3414.         fwptr := FrontWindow;
  3415.         if fwptr <> nil then begin
  3416.                 kind := WindowPeek(fwptr)^.WindowKind;
  3417.                 if (kind = PicKind) or (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) or (kind = HistoKind) or (Kind = PasteControlKind) or (Kind = ResultsKind) or (Kind = TextKind) then
  3418.                     MoveWindow(fwptr, x, y, true);
  3419.             end;
  3420.     end;
  3421.  
  3422.  
  3423.     procedure DoUserCode; {str:str255; Param1,Param2,Param3:real;}
  3424.   {Contributed by Mark Vivino}
  3425.         var
  3426.             WhichCode: integer;
  3427.             Param1, Param2, Param3: extended;
  3428.             str: str255;
  3429.             NewVersion: boolean;
  3430.     begin
  3431.         GetLeftParen;
  3432.         GetToken;
  3433.         NewVersion := (token = StringLiteral) or (token = StringVariable);
  3434.         PutTokenBack;
  3435.         WhichCode := 0;
  3436.         str := '';
  3437.         if NewVersion then
  3438.             str := GetString
  3439.         else
  3440.             WhichCode := GetInteger;
  3441.         GetComma;
  3442.         Param1 := GetExpression;
  3443.         GetComma;
  3444.         Param2 := GetExpression;
  3445.         GetComma;
  3446.         Param3 := GetExpression;
  3447.         GetRightParen;
  3448.         if Token <> DoneT then begin
  3449.                 if NewVersion then
  3450.                     UserMacroCode(str, Param1, Param2, Param3)
  3451.                 else begin
  3452.                         if (WhichCode < 1) or (WhichCode > 10) then
  3453.                             MacroError('Range error . Allowable range is 1 to 10.');
  3454.                         OldUserMacroCode(WhichCode, Param1, Param2, Param3);
  3455.                     end;
  3456.             end;
  3457.     end;
  3458.  
  3459.  
  3460.     procedure CloseSerialPorts;
  3461.         var
  3462.             err: OSErr;
  3463.     begin
  3464.         if SerialBufferP <> nil then begin
  3465.                 err := CloseDriver(SerialOut);
  3466.                 err := CloseDriver(SerialIn);
  3467.                 DisposePtr(SerialBufferP);
  3468.             end;
  3469.     end;
  3470.  
  3471.  
  3472.     procedure OpenSerial;
  3473.         const
  3474.             SerialBufferSize = 1024;
  3475.         var
  3476.             err: OSErr;
  3477.             baud, data, stop, parity, i: integer;
  3478.             config: integer;
  3479.             flags: SerShk;
  3480.             str: str255;
  3481.     begin
  3482.         CloseSerialPorts;
  3483.         baud := baud9600;
  3484.         data := data8;
  3485.         stop := stop10;
  3486.         parity := noParity;
  3487.         str := GetStringArg;
  3488.         if token = DoneT then
  3489.             exit(OpenSerial);
  3490.         MakeLowerCase(str);
  3491.         if pos('300', str) <> 0 then
  3492.             baud := baud300;
  3493.         if pos('1200', str) <> 0 then
  3494.             baud := baud1200;
  3495.         if pos('2400', str) <> 0 then
  3496.             baud := baud2400;
  3497.         if pos('19200', str) <> 0 then
  3498.             baud := baud19200;
  3499.         if pos('two', str) <> 0 then
  3500.             stop := stop20;
  3501.         if pos('seven', str) <> 0 then
  3502.             data := data7;
  3503.         i:=pos('even', str);
  3504.         if (i <> 0) and (str[i-1]<>'s') then
  3505.             parity := evenParity;
  3506.         if pos('odd', str) <> 0 then
  3507.             parity := oddParity;
  3508.         if (OpenDriver('.AOut', SerialOut) <> NoErr) or (OpenDriver('.AIn', SerialIn) <> NoErr) then begin
  3509.                 MacroError('Error opening modem port');
  3510.                 exit(OpenSerial);
  3511.             end;
  3512.         SerialBufferP := NewPtr(SerialBufferSize);
  3513.         if SerialBufferP = nil then begin
  3514.                 MacroError('Out of Memory');
  3515.                 exit(OpenSerial);
  3516.             end;
  3517.         with flags do begin
  3518.                 fXOn := ord(false); {Disable xon/xoff output flow control}
  3519.                 fCTS := ord(false); {Disable CTS (output) flow control}
  3520.                 xOn := chr(17);
  3521.                 xOff := chr(19);
  3522.                 errs := 0;
  3523.                 evts := 0;
  3524.                 fInX := ord(true);  {Enable xon/xoff input flow control}
  3525.                 fDTR := ord(true); {Enable DTR (input) flow control}
  3526.             end;
  3527.         Config := baud + data + stop + parity;
  3528.         Err := SerHShake(SerialOut, flags);
  3529.         Err := SerSetBuf(SerialIn, SerialBufferP, SerialBufferSize);
  3530.         Err := SerReset(SerialOut, Config);
  3531.     end;
  3532.  
  3533.  
  3534.     procedure PutSerial;
  3535.         var
  3536.             i: integer;
  3537.             Size: LongInt;
  3538.             OutputBuffer: packed array[1..256] of char;
  3539.             str: str255;
  3540.             err: OSErr;
  3541.     begin
  3542.         GetArguments(str);
  3543.         if token = DoneT then
  3544.             exit(PutSerial);
  3545.         if SerialBufferP = nil then begin
  3546.                 MacroError('Serial port not open');
  3547.                 exit(PutSerial);
  3548.             end;
  3549.         Size := 0;
  3550.         for i := 1 to length(str) do begin
  3551.                 size := size + 1;
  3552.                 OutputBuffer[size] := str[i];
  3553.             end;
  3554.         if size > 0 then
  3555.             err := fswrite(SerialOut, size, @OutputBuffer);
  3556.     end;
  3557.  
  3558.  
  3559.     procedure DoSetCursor; {str: string}
  3560.         var
  3561.             str: str255;
  3562.     begin
  3563.         str := GetStringArg;
  3564.         if Token <> DoneT then begin
  3565.                 MakeLowerCase(str);
  3566.                 if pos('watch', str) <> 0 then
  3567.                     SetCursor(watch);
  3568.                 if pos('cross', str) <> 0 then
  3569.                     SetCursor(ToolCursor[SelectionTool]);
  3570.                 if pos('arrow', str) <> 0 then
  3571.                     InitCursor;
  3572.                 if pos('finger', str) <> 0 then
  3573.                     SetCursor(FingerCursor);
  3574.             end;
  3575.     end;
  3576.  
  3577.  
  3578.     procedure SetVideoOptions; {options: string[, gain:integer, offset:integer]}
  3579.         var
  3580.             options: str255;
  3581.             NewSyncMode: SyncModeType;
  3582.       gain, offset: integer;
  3583.  
  3584.         procedure SetOption (id: integer; var option: boolean; enable: boolean);
  3585.     {Updates the modeless Video Control dialog box.}
  3586.         begin
  3587.             if option <> enable then
  3588.                 DoVideoControl(id)
  3589.         end;
  3590.  
  3591.     begin
  3592.         GetLeftParen;
  3593.         options := GetString;
  3594.         GetToken;
  3595.         if token = comma then begin
  3596.             gain := GetInteger;
  3597.             GetComma;
  3598.             offset := GetInteger
  3599.         end
  3600.         else begin
  3601.             PutTokenBack;
  3602.             gain := 255 - (DacHigh - DacLow);
  3603.             offset := DacLow;
  3604.         end;
  3605.         GetRightParen;
  3606.         if Token <> DoneT then begin
  3607.                 MakeLowerCase(options);
  3608.                 SetOption(InvertID, InvertVideo, pos('invert', options) <> 0);
  3609.                 SetOption(HighlightID, HighlightSaturatedPixels, pos('high', options) <> 0);
  3610.                 SetOption(TriggerID, ExternalTrigger, pos('trig', options) <> 0);
  3611.                 if pos('sep', options) <> 0 then
  3612.                     NewSyncMode := SeparateSync
  3613.                 else
  3614.                     NewSyncMode := NormalSync;
  3615.                 if NewSyncMode <> SyncMode then
  3616.                     DoVideoControl(SyncID);
  3617.                 SetOffset(offset, gain);
  3618.                 SetGain(offset, gain);
  3619.                 if VideoControl <> nil then begin
  3620.                     gain := 255 - (DacHigh - DacLow);
  3621.                     ShowOffsetAndGain(DacLow, gain);
  3622.                 end;
  3623.                 OscillatingMovies := pos('osc', options) <> 0;
  3624.                 BlindMovieCapture := pos('blind', options) <>0;
  3625.                 if (FrameGrabber = ScionLG3) or (FrameGrabber=ScionAG5) or (FrameGrabber=ScionVG5f) then begin
  3626.                         DacLowReg^ := DacLow;
  3627.                         DacHighReg^ := DacHigh;
  3628.                     end;
  3629.             end;
  3630.     end;
  3631.  
  3632.  
  3633.     procedure SetChannel; {(channel:integer)}
  3634.         var
  3635.             channel: integer;
  3636.     begin
  3637.         GetLeftParen;
  3638.         channel := GetInteger;
  3639.         GetRightParen;
  3640.         if (channel < 1) or (channel > 4) then
  3641.             MacroError('Bad channel number')
  3642.         else
  3643.             DoVideoControl(FirstChannelID + channel - 1);
  3644.     end;
  3645.  
  3646.  
  3647.     procedure DoAcquire;
  3648.         var
  3649.             fname: str255;
  3650.     begin
  3651.         fname := GetStringArg;
  3652.         LoadAcqPlugIn(fname);
  3653.     end;
  3654.  
  3655.  
  3656.     procedure CallExportPlugin;
  3657.         var
  3658.             fname: str255;
  3659.     begin
  3660.         fname := GetStringArg;
  3661.         LoadExportPlugIn(fname);
  3662.     end;
  3663.  
  3664.  
  3665.     procedure CallFilterPlugin;
  3666.         var
  3667.             fname: str255;
  3668.     begin
  3669.         fname := GetStringArg;
  3670.         LoadFilterPlugIn(fname);
  3671.     end;
  3672.  
  3673.  
  3674.     procedure DoPhotoMode;
  3675.         var
  3676.             erase: boolean;
  3677.     begin
  3678.         erase := GetBooleanArg;
  3679.         if Token <> DoneT then begin
  3680.                 if erase then begin
  3681.                         EraseScreen;
  3682.                         UpdatePicWindow;
  3683.                         InPhotoMode := true;
  3684.                     end
  3685.                 else if InPhotoMode then
  3686.                         RestoreScreen;
  3687.             end;
  3688.     end;
  3689.  
  3690.  
  3691.     procedure RGBToIndexed; {options: string}
  3692.         var
  3693.             options: str255;
  3694.     begin
  3695.         options := GetStringArg;
  3696.         if Token <> DoneT then begin
  3697.                 MakeLowerCase(options);
  3698.                 RGBLut := CustomLUT;
  3699.                 DitherColor := false;
  3700.                 if pos('exist', options) <> 0 then
  3701.                     RGBLut := ExistingLUT;
  3702.                 if pos('system', options) <> 0 then
  3703.                     RGBLut := SystemLUT;
  3704.                 if pos('dither', options) <> 0 then
  3705.                     DitherColor := true;
  3706.                 ConvertRGBToEightBitColor(false);
  3707.             end;
  3708.     end;
  3709.  
  3710.  
  3711.  procedure DoAverageFrames; {[(Options:string; nFrames:integer)]}
  3712.   var
  3713.    options: str255;
  3714.    nFrames: LongInt;
  3715.    HasArguments,ShowDialog,okay: boolean;
  3716.  begin
  3717.   GetToken;
  3718.   HasArguments := token = LeftParen;
  3719.   PutTokenBack;
  3720.   ShowDialog:=false;
  3721.   if HasArguments then begin
  3722.     GetLeftParen;
  3723.     Options := GetString;
  3724.     GetComma;
  3725.     nFrames := GetInteger;
  3726.     ShowDialog:= nFrames <= 0;
  3727.     if not ShowDialog then
  3728.         FramesToAverage := nFrames;
  3729.     GetRightParen;
  3730.     if (Token <> DoneT) then begin
  3731.       MakeLowerCase(options);
  3732.       VideoRateAveraging := false;
  3733.       SumFrames := false;
  3734.       IntegrateOnChip := false;
  3735.       if (pos('int', options) <> 0) or (pos('sum', options) <> 0) then
  3736.        sumFrames := true;
  3737.       if pos('video', options) <> 0 then
  3738.        VideoRateAveraging := true;
  3739.       if (pos('camera', options) <> 0) or (pos('chip', options) <> 0) then begin
  3740.        if  (FrameGrabber<>ScionLG3) and (FrameGrabber<>ScionAG5) and (FrameGrabber<>ScionVG5f) then begin
  3741.          MacroError('On-chip integration requires a Scion frame grabber.');
  3742.          exit(DoAverageFrames)
  3743.        end;
  3744.        VideoRateAveraging := false;
  3745.        SumFrames := false;
  3746.        IntegrateOnChip := true;
  3747.        end;
  3748.      end;
  3749.    end; {has arguments}
  3750.   if token <> DoneT then begin
  3751.    if ShowDialog
  3752.     then okay:=DoAveragingOptions
  3753.     else okay:=true;
  3754.    if okay then AverageFrames;
  3755.   end;
  3756.  end;
  3757.  
  3758.  
  3759.     procedure DoSelectWindow;{('str')}
  3760.         var
  3761.             str, wTitle: str255;
  3762.             WPeek, NextWPeek: WindowPeek;
  3763.             id: integer;
  3764.             TempInfo: InfoPtr;
  3765.     begin
  3766.         GetArguments(str);
  3767.         MakeLowerCase(str);
  3768.         if Token <> DoneT then begin
  3769.                 wPeek := WindowPeek(FrontWindow);
  3770.                 while wPeek <> nil do begin
  3771.                         NextWPeek := wPeek^.NextWindow;
  3772.                         if wPeek^.WindowKind = PicKind then begin
  3773.                                 TempInfo := InfoPtr(wPeek^.RefCon);
  3774.                                 wTitle := TempInfo^.title;
  3775.                             end
  3776.                         else
  3777.                             wTitle := wPeek^.TitleHandle^^;
  3778.                         MakeLowerCase(wTitle);
  3779.                         if str = wTitle then begin
  3780.                                 if wPeek^.WindowKind = PicKind then begin
  3781.                                         info := InfoPtr(wPeek^.RefCon);
  3782.                                         with info^ do
  3783.                                             if (PicNum >= 1) and (PicNum <= nPics) then
  3784.                                                 SelectImage(PicNum);
  3785.                                     end
  3786.                                 else
  3787.                                     SelectWindow(WindowPtr(wPeek));
  3788.                                 leave;
  3789.                             end;
  3790.                         wpeek := NextWPeek;
  3791.                     end;
  3792.                 if wPeek = nil then
  3793.                     MacroError('Window not found');
  3794.             end;
  3795.     end;
  3796.  
  3797.  
  3798.     procedure GetThreshold;  {(lower,upper)}
  3799.         var
  3800.             loc1, loc2: integer;
  3801.     begin
  3802.         GetLeftParen;
  3803.         loc1 := GetVar;
  3804.         GetComma;
  3805.         loc2 := GetVar;
  3806.         GetRightParen;
  3807.         if Token <> DoneT then
  3808.             with MacrosP^ do
  3809.                 with info^ do begin
  3810.                         if Thresholding then begin
  3811.                                 stack[loc1].value := ColorStart;
  3812.                                 stack[loc2].value := 255;
  3813.                             end
  3814.                         else if DensitySlicing then begin
  3815.                                 stack[loc1].value := SliceStart;
  3816.                                 stack[loc2].value := SliceEnd;
  3817.                             end
  3818.                         else begin
  3819.                                 stack[loc1].value := 0;
  3820.                                 stack[loc2].value := 0;
  3821.                             end;
  3822.                     end;
  3823.     end;
  3824.  
  3825.  
  3826.     procedure SortPalette;
  3827.         type
  3828.             MyHSVColor = record
  3829.                     lHue, lSaturation, lValue: LongInt;
  3830.                 end;
  3831.             HSVRec = record
  3832.                     index: integer;
  3833.                     hsv: MyHSVColor;
  3834.                 end;
  3835.             HSVArrayType = array[0..255] of HSVRec;
  3836.         var
  3837.             TempTable: MyCSpecArray;
  3838.             i: integer;
  3839.             HSVArray: HSVArrayType;
  3840.             h, s, v: LongInt;
  3841.             fHue, fSaturation, fValue: fixed;
  3842.             TempHSV: HSVColor;
  3843.             table: LookupTable;
  3844.  
  3845.         procedure SortByHue;
  3846.     {Selection sorts from "Algorithms" by Robert Sedgewick.}
  3847.             var
  3848.                 i, j, min: integer;
  3849.                 t: HSVRec;
  3850.         begin
  3851.             for i := 1 to 254 do begin
  3852.                     min := i;
  3853.                     for j := i + 1 to 254 do
  3854.                         if HSVArray[j].hsv.lHue < HSVArray[min].hsv.lHue then
  3855.                             min := j;
  3856.                     t := HSVArray[min];
  3857.                     HSVArray[min] := HSVArray[i];
  3858.                     HSVArray[i] := t;
  3859.                 end;
  3860.         end;
  3861.  
  3862.     begin
  3863.         ShowWatch;
  3864.         DisableDensitySlice;
  3865.         with info^ do begin
  3866.                 for i := 1 to 254 do begin
  3867.                         HSVArray[i].index := i;
  3868.                         rgb2hsv(cTable[i].rgb, TempHSV);
  3869.                         with TempHSV do begin
  3870.                                 fHue := SmallFract2Fix(hue);
  3871.                                 fSaturation := SmallFract2Fix(saturation);
  3872.                                 fValue := SmallFract2Fix(value);
  3873.                             end;
  3874.                         with HSVArray[i].hsv do begin
  3875.                                 lHue := ord4(band(fHue, $ffff));
  3876.                                 lSaturation := ord4(band(fSaturation, $ffff));
  3877.                                 lValue := ord4(band(fValue, $ffff));
  3878.                             end;
  3879.                     end;
  3880.                 SortByHue;
  3881.                 for i := 1 to 254 do
  3882.                     TempTable[i].rgb := cTable[HSVArray[i].index].rgb;
  3883.                 cTable := TempTable;
  3884.                 LoadLUT(cTable);
  3885.                 if info <> NoInfo then begin
  3886.                         table[0] := 0;
  3887.                         table[255] := 255;
  3888.                         for i := 1 to 254 do
  3889.                             table[HSVArray[i].index] := i;
  3890.                         ApplyTable(table);
  3891.                     end;
  3892.                 WhatToUndo := NothingToUndo;
  3893.                 SetupPseudocolor;
  3894.                 ColorTable := CustomTable;
  3895.             end; {with}
  3896.     end;
  3897.  
  3898.  
  3899.     procedure DoProject;
  3900.     begin
  3901.         if info^.StackInfo = nil then begin
  3902.             MacroError('Stack required');
  3903.             exit(DoProject);
  3904.         end;
  3905.         if not ((ProjectC in RoutinesCalled) or (SetProjectionC in RoutinesCalled)) then begin
  3906.                 if ShowProjectDialogBox then
  3907.                     DoProjection
  3908.                 else
  3909.                     token := DoneT;
  3910.             end
  3911.         else with info^.StackInfo^ do begin
  3912.             if SliceSpacing <= 0.0 then
  3913.                 SliceSpacing := 1.0;
  3914.             if DensitySlicing then
  3915.                 with info^ do begin
  3916.                         TransparencyLower := SliceStart;
  3917.                         TransparencyUpper := SliceEnd;
  3918.                     end;
  3919.             DoProjection;
  3920.         end;
  3921.         RoutinesCalled := RoutinesCalled + [ProjectC];
  3922.     end;
  3923.  
  3924.  
  3925.     procedure DoNewTextWindow; {(name,width,height)}
  3926.         var
  3927.             str: str255;
  3928.             okay, OptionalArguments: boolean;
  3929.             width, height: LongInt;
  3930.     begin
  3931.         GetLeftParen;
  3932.         str := GetString;
  3933.         GetToken;
  3934.         OptionalArguments := token <> RightParen;
  3935.         PutTokenBack;
  3936.         width := 500;
  3937.         height := 400;
  3938.         if OptionalArguments then begin
  3939.                 GetComma;
  3940.                 width := GetInteger;
  3941.                 if width < 8 then
  3942.                     width := 8;
  3943.                 GetComma;
  3944.                 height := GetInteger;
  3945.                 if height < 8 then
  3946.                     height := 8;
  3947.             end;
  3948.         GetRightParen;
  3949.         if Token <> DoneT then
  3950.             okay := MakeNewTextWindow(str, width, height);
  3951.     end;
  3952.  
  3953.  
  3954.     procedure ImageMath; {('op',pic1,pic2,gain,offset,'result')}
  3955.         var
  3956.             op, result: str255;
  3957.             pic1, pic2, DstPidNum: LongInt;
  3958.             gain, offset: extended;
  3959.             roi:rect;
  3960.             DstInfo:InfoPtr;
  3961.             isPidNum:boolean;
  3962.     begin
  3963.         GetLeftParen;
  3964.         op := GetString;
  3965.         GetComma;
  3966.         pic1 := GetInteger;
  3967.         GetComma;
  3968.         pic2 := GetInteger;
  3969.         GetComma;
  3970.         gain := GetExpression;
  3971.         GetComma;
  3972.         offset := GetExpression;
  3973.         GetComma;
  3974.         GetToken;
  3975.         isPidNum:=token=variable;
  3976.         PutTokenBack;
  3977.         if isPidNum
  3978.             then DstPidNum:=GetInteger
  3979.             else result := GetString;
  3980.         GetRightParen;
  3981.         if token <> DoneT then begin
  3982.                 MakeLowerCase(op);
  3983.                 RealImageMath:=false;
  3984.                 if pos('calibrate', op) <> 0 then
  3985.                     RealImageMath := true;
  3986.                 if pos('real', op) <> 0 then
  3987.                     RealImageMath := true;
  3988.                 if pos('add', op) <> 0 then
  3989.                     CurrentMathOp := AddMath;
  3990.                 if pos('sub', op) <> 0 then
  3991.                     CurrentMathOp := SubMath;
  3992.                 if pos('mul', op) <> 0 then
  3993.                     CurrentMathOp := MulMath;
  3994.                 if (pos('cmul', op) <> 0) or (pos('conjugate', op) <> 0) then begin
  3995.                     CurrentMathOp := cMulMath;
  3996.                     RealImageMath := true;
  3997.                 end;
  3998.                 if pos('div', op) <> 0 then
  3999.                     CurrentMathOp := DivMath;
  4000.                 if pos('and', op) <> 0 then
  4001.                     CurrentMathOp := AndMath;
  4002.                 if pos('or', op) <> 0 then
  4003.                     CurrentMathOp := OrMath;
  4004.                 if pos('xor', op) <> 0 then
  4005.                     CurrentMathOp := XorMath;
  4006.                 if pos('max', op) <> 0 then
  4007.                     CurrentMathOp := MaxMath;
  4008.                 if pos('min', op) <> 0 then
  4009.                     CurrentMathOp := MinMath;
  4010.                 if pos('copy', op) <> 0 then
  4011.                     CurrentMathOp := CopyMath;
  4012.                 MathGain := gain;
  4013.                 MathOffset := offset;
  4014.                 if not GetMathRoi(pic1, pic2, roi) then
  4015.                     exit(ImageMath);
  4016.                 if isPidNum then begin
  4017.                     DstInfo := GetInfoPtr(DstPidNum);
  4018.                     if DstInfo=nil then begin
  4019.                         MacroError('Bad pid number');
  4020.                         exit(ImageMath);
  4021.                     end;
  4022.                     if RealImageMath and (DstInfo^.dataH = nil) then begin
  4023.                         MacroError('Real output image required');
  4024.                         exit(ImageMath);
  4025.                     end;
  4026.                     SelectWindow(DstInfo^.wptr);
  4027.                     Info := DstInfo;
  4028.                     ActivateWindow;
  4029.                     LoadLUT(info^.cTable);
  4030.                     UpdatePicWindow;
  4031.                     KillRoi;
  4032.                 end else begin
  4033.                     with roi do
  4034.                         if RealImageMath then begin
  4035.                             if not NewRealWindow(result, right-left, bottom-top) then
  4036.                                 exit(ImageMath)
  4037.                         end else begin
  4038.                             if not NewPicWindow(result, right-left, bottom-top) then
  4039.                                 exit(ImageMath)
  4040.                         end;
  4041.                     DstInfo := Info;
  4042.                 end;
  4043.                 DoMath(pic1, pic2, DstInfo, roi);
  4044.             end;
  4045.     end;
  4046.  
  4047.  
  4048.     procedure PasteLive;
  4049.     begin
  4050.         with info^ do begin
  4051.                 if not RoiShowing or (RoiType <> RectRoi) then begin
  4052.                         MacroError('No selection');
  4053.                         exit(PasteLive);
  4054.                     end;
  4055.                 if PictureType = FrameGrabberType then begin
  4056.                         MacroError('Can''t paste into Camera window');
  4057.                         exit(PasteLive);
  4058.                     end;
  4059.                 if FrameGrabber = NoFrameGrabber then begin
  4060.                         MacroError('No frame grabber');
  4061.                         exit(PasteLive);
  4062.                     end;
  4063.                 if (RoiRect.right > fgwidth) or (RoiRect.bottom > fgheight) then begin
  4064.                         MacroError('Selection out of range');
  4065.                         exit(PasteLive);
  4066.                     end;
  4067.                 SetupUndo;
  4068.                 WhatToUndo := UndoPaste;
  4069.                 ClipBufInfo^.RoiRect := RoiRect;
  4070.                 OpPending := true;
  4071.                 CurrentOp := PasteOp;
  4072.                 LivePasteMode := true;
  4073.                 WhatsOnClip := LivePic;
  4074.             end;{with}
  4075.     end;
  4076.  
  4077.  
  4078.     procedure GetPlotData;  {(var nValues,PixelsPerValue, Min,Max:real)}
  4079.         var
  4080.             loc1, loc2, loc3, loc4: integer;
  4081.     begin
  4082.         GetLeftParen;
  4083.         loc1 := GetVar;
  4084.         GetComma;
  4085.         loc2 := GetVar;
  4086.         GetComma;
  4087.         loc3 := GetVar;
  4088.         GetComma;
  4089.         loc4 := GetVar;
  4090.         GetRightParen;
  4091.         if Token <> DoneT then
  4092.             with MacrosP^, results do begin
  4093.                     ShowPlot := false;
  4094.                     PlotDensityProfile;
  4095.                     ShowPlot := true;
  4096.                     stack[loc1].value := PlotCount;
  4097.                     stack[loc2].value := PlotAvg;
  4098.                     stack[loc3].value := ActualPlotMin;
  4099.                     stack[loc4].value := ActualPlotMax;
  4100.                 end;
  4101.     end;
  4102.  
  4103.  
  4104.     procedure DoDelete;  {(var dest; index, count:integer)}
  4105.         var
  4106.             StackLoc, index, count: integer;
  4107.             str: str255;
  4108.     begin
  4109.         GetLeftParen;
  4110.         StackLoc := GetStringVar;
  4111.         str := TokenStr;
  4112.         GetComma;
  4113.         index := GetInteger;
  4114.         GetComma;
  4115.         count := GetInteger;
  4116.         GetRightParen;
  4117.         if Token <> DoneT then
  4118.             with MacrosP^.stack[StackLoc] do begin
  4119.                     delete(str, index, count);
  4120.                     if StringH <> nil then
  4121.                         StringH^^ := str;
  4122.                 end;
  4123.     end;
  4124.  
  4125.  
  4126.     procedure DoAutoOutline;  {(x,y:integer)}
  4127.         var
  4128.             x, y: integer;
  4129.             start: point;
  4130.     begin
  4131.         GetLeftParen;
  4132.         x := GetInteger;
  4133.         GetComma;
  4134.         y := GetInteger;
  4135.         GetRightParen;
  4136.         if Token <> DoneT then begin
  4137.                 start.h := x;
  4138.                 start.v := y;
  4139.                 AutoOutline(start);
  4140.             end;
  4141.     end;
  4142.  
  4143.  
  4144.     procedure DoFilter; {(fType:string)}
  4145.         var
  4146.             fType: str255;
  4147.             doMore:boolean;
  4148.             t:FateTable;
  4149.     begin
  4150.         GetLeftParen;
  4151.         fType := GetString;
  4152.         GetRightParen;
  4153.         if token <> DoneT then begin
  4154.                 MakeLowerCase(fType);
  4155.                 doMore:=pos('more', fType) <> 0;
  4156.                 if pos('smooth', fType) <> 0 then begin
  4157.                     if doMore then
  4158.                         Filter(UnweightedAvg, 0, t)
  4159.                     else
  4160.                         Filter(WeightedAvg, 0, t);
  4161.                     exit(DoFilter);
  4162.                 end;
  4163.                 if pos('sharpen', fType) <> 0 then begin
  4164.                     if doMore then
  4165.                         Filter(SharpenMore, 0, t)
  4166.                     else
  4167.                         Filter(fsharpen, 0, t);
  4168.                     exit(DoFilter);
  4169.                 end;
  4170.                 if pos('median', fType) <> 0 then begin
  4171.                     RankFilter := MedianRank;
  4172.                     DoRankFilter;
  4173.                     exit(DoFilter);
  4174.                 end;
  4175.                 if (pos('edges', fType) <> 0) or (pos('sobel', fType)<>0) then begin
  4176.                     Filter(FindEdges, 0, t);
  4177.                     exit(DoFilter);
  4178.                 end;
  4179.                 if pos('dither', fType) <> 0 then begin
  4180.                     Filter(Dither, 0, t);
  4181.                     exit(DoFilter);
  4182.                 end;
  4183.                 if pos('min', fType) <> 0 then begin
  4184.                     RankFilter := MinRank;
  4185.                     DoRankFilter;
  4186.                     exit(DoFilter);
  4187.                 end;
  4188.                 if pos('max', fType) <> 0 then begin
  4189.                     RankFilter := MaxRank;
  4190.                     DoRankFilter;
  4191.                     exit(DoFilter);
  4192.                 end;
  4193.                 MacroError('Undefined filter');
  4194.             end;
  4195.     end;
  4196.  
  4197.  
  4198.     procedure DoShadow; {[(Direction:string)]}
  4199.         var
  4200.             direction: str255;
  4201.             t: FateTable;
  4202.     begin
  4203.         GetToken;
  4204.         if token =LeftParen then begin
  4205.             direction := GetString;
  4206.             MakeLowerCase(direction);
  4207.             GetRightParen;
  4208.         end else begin
  4209.             PutTokenBack;
  4210.             direction:='se';
  4211.         end;
  4212.         if Token <> DoneT then
  4213.         if direction='n' then Filter(ShadowN, 0, t)
  4214.         else if direction='ne' then Filter(ShadowNE, 0, t)
  4215.         else if direction='e'  then Filter(ShadowE, 0, t)
  4216.         else if direction='se' then Filter(ShadowSE, 0, t)
  4217.         else if direction='s'  then Filter(ShadowS, 0, t)
  4218.         else if direction='sw' then Filter(ShadowSW, 0, t)
  4219.         else if direction='w'  then Filter(ShadowW, 0, t)
  4220.         else if direction='nw' then Filter(ShadowNW, 0, t)
  4221.         else MacroError('Invalid direction');
  4222.         end;
  4223.  
  4224.  
  4225.     procedure DoCalibrate; {(fit,unit:string,m1,k1,m2,k2,...)}
  4226.         var
  4227.             sFit, sUnit: str255;
  4228.             Measured, Known:StandardsArray;
  4229.             nPairs, i:integer;
  4230.     begin
  4231.         GetLeftParen;
  4232.         sFit := GetString;
  4233.         if token <> DoneT then with info^ do begin
  4234.                 MakeLowerCase(sFit);
  4235.                 if pos('straight', sFit) <> 0 then fit:=StraightLine
  4236.                 else if pos('rodbard', sFit) <> 0 then fit:=RodbardFit
  4237.                 else if pos('od', sFit) <> 0 then fit:=UncalibratedOD
  4238.                 else if pos('uncal', sFit) <> 0 then fit:=Uncalibrated
  4239.                 else if pos('exp', sFit) <> 0 then fit:=ExpoFit
  4240.                 else if pos('log', sFit) <> 0 then fit:=LogFit
  4241.                 else if pos('pow', sFit) <> 0 then fit:=PowerFit
  4242.                 else if pos('poly2', sFit) <> 0 then fit:=Poly2
  4243.                 else if pos('poly3', sFit) <> 0 then fit:=Poly3
  4244.                 else if pos('poly4', sFit) <> 0 then fit:=Poly4
  4245.                 else if pos('poly5', sFit) <> 0 then fit:=Poly5
  4246.                 else begin
  4247.                     MacroError('Unknown fit');
  4248.                     exit(DoCalibrate);
  4249.                 end;
  4250.                 if (fit=Uncalibrated) or (fit=UncalibratedOD) then begin
  4251.                     GetRightParen;
  4252.                     Calibrate;
  4253.                     exit(DoCalibrate);
  4254.                 end;
  4255.         end;
  4256.         GetComma;
  4257.         sUnit := GetString;
  4258.         GetComma;
  4259.         nPairs:=0;
  4260.         GetToken;
  4261.         while (token<>RightParen) and (token<>DoneT) do begin
  4262.             PutTokenBack;
  4263.             if nPairs<MaxStandards then
  4264.                 nPairs:=nPairs+1;
  4265.             Measured[nPairs]:=GetExpression;
  4266.             GetComma;
  4267.             Known[nPairs]:=GetExpression;
  4268.             GetToken;
  4269.             if token=comma then
  4270.                 GetToken;
  4271.         end;
  4272.         if token <> DoneT then with info^ do begin
  4273.                 if nPairs<2 then begin
  4274.                     MacroError('More arguments expected');
  4275.                     exit(DoCalibrate);
  4276.                 end;
  4277.                 TruncateString(sUnit, maxUM);
  4278.                 UnitOfMeasure:=sUnit;
  4279.                 nStandards:=nPairs;
  4280.                 nKnownValues:=nPairs;
  4281.                 for i:=1 to nStandards do begin
  4282.                     ClearResults(i);
  4283.                     uMean[i]:=Measured[i];
  4284.                     Mean^[i]:=Measured[i];
  4285.                     StandardValues[i]:=Known[i];
  4286.                 end;
  4287.                 mCount := nStandards;
  4288.                 UpdateList;
  4289.                 Calibrate;
  4290.             end;
  4291.     end;
  4292.  
  4293.  
  4294.     procedure DoMakeMovie; {(Options:string; nFrames:integer; delay:extended)}
  4295.         var
  4296.             options: str255;
  4297.             nFrames: integer;
  4298.             delay: extended;
  4299.             ShowDialog: boolean;
  4300.     begin
  4301.             GetLeftParen;
  4302.             Options := GetString;
  4303.             GetComma;
  4304.             nFrames := GetInteger;
  4305.             GetComma;
  4306.             delay := GetExpression;
  4307.             GetRightParen;
  4308.             if (Token <> DoneT) then begin
  4309.                     ShowDialog := pos('dialog', options) <> 0;
  4310.                     if ShowDialog and (length(options) = 6) then begin
  4311.                         MakeMovie(true);
  4312.                         exit(DoMakeMovie);
  4313.                     end;
  4314.                     if nFrames > 0 then
  4315.                         FramesWanted := nFrames;
  4316.                     if delay >= 0.0 then
  4317.                         SecondsPerFrame := delay;
  4318.                     MakeLowerCase(options);
  4319.                     BlindMovieCapture := false;
  4320.                     LG3BufferCapture := false;
  4321.                     TriggerFirstFrameOnly := true;
  4322.                     TimeStamp := false;
  4323.                     UseExistingStack := false;
  4324.                     if pos('blind', options) <> 0 then
  4325.                         BlindMovieCapture := true;
  4326.                     if (pos('buffer', options) <> 0) then
  4327.                         LG3BufferCapture := true;
  4328.                     if (pos('stamp', options) <> 0) then
  4329.                             TimeStamp := true;
  4330.                     if (pos('trigger', options) <> 0) and (pos('first', options) <> 0) then begin
  4331.                         ExternalTrigger := true;
  4332.                         TriggerFirstFrameOnly := true;
  4333.                       end;
  4334.                     if (pos('trigger', options) <> 0) and (pos('each', options) <> 0) then begin
  4335.                         ExternalTrigger := true;
  4336.                         TriggerFirstFrameOnly := false;
  4337.                       end;
  4338.                     if (pos('existing', options) <> 0) then
  4339.                             UseExistingStack := true;
  4340.                     MakeMovie(ShowDialog);
  4341.                 end;
  4342.     end;
  4343.  
  4344.  
  4345.     procedure DoAnalyzeParticles; {[(Options:string)]}
  4346.         var
  4347.             options: str255;
  4348.             hasOptions, okay: boolean;
  4349.     begin
  4350.         GetToken;
  4351.         hasOptions := token = LeftParen;
  4352.         PutTokenBack;
  4353.         if hasOptions then begin
  4354.             GetArguments(options);
  4355.             MakeLowerCase(options);
  4356.             if pos('dialog', options) <> 0 then begin
  4357.                 okay := DoAPDialog;
  4358.                 if okay then
  4359.                     AnalyzeParticles;
  4360.                 exit(DoAnalyzeParticles);
  4361.             end;
  4362.             LabelParticles := false;
  4363.             OutlineParticles := false;
  4364.             IgnoreParticlesTouchingEdge := false;
  4365.             IncludeHoles := false;
  4366.             APReset := false;
  4367.             if pos('label', options) <> 0 then
  4368.                 LabelParticles := true;
  4369.             if pos('outline', options) <> 0 then
  4370.                 OutlineParticles := true;
  4371.             if pos('ignore', options) <> 0 then
  4372.                 IgnoreParticlesTouchingEdge := true;
  4373.             if pos('include', options) <> 0 then
  4374.                 IncludeHoles := true;
  4375.             if pos('reset', options) <> 0 then
  4376.                 APReset := true;
  4377.         end;
  4378.         AnalyzeParticles;
  4379.     end;
  4380.  
  4381.  
  4382.   procedure SetProjection;
  4383.     var
  4384.       v: extended;
  4385.       s: str255;
  4386.   begin
  4387.     GetLeftParen;
  4388.     s := GetString;
  4389.         MakeLowerCase(s);
  4390.     if pos('x-axis', s) <> 0 then
  4391.       AxisOfRotation := XAxis
  4392.     else if pos('y-axis', s) <> 0 then
  4393.       AxisOfRotation := YAxis
  4394.     else if pos('z-axis', s) <> 0 then
  4395.       AxisOfRotation := ZAxis
  4396.     else if pos('nearest', s) <> 0 then
  4397.       ProjectionMethod := NearestPoint
  4398.     else if pos('brightest', s) <> 0 then
  4399.       ProjectionMethod := BrightestPoint
  4400.     else if pos('mean', s) <> 0 then
  4401.       ProjectionMethod := MeanValue
  4402.     else begin
  4403.         GetComma;
  4404.         if pos('save', s) <> 0 then
  4405.           SaveProjections := GetBoolean
  4406.         else if pos('minimize', s) <> 0 then
  4407.           MinProjSize := GetBoolean
  4408.         else begin
  4409.             v := GetExpression;
  4410.             if pos('initial', s) <> 0 then
  4411.               InitAngle := round(v)
  4412.             else if pos('total', s) <> 0 then
  4413.               TotalAngle := round(v)
  4414.             else if pos('increment', s) <> 0 then
  4415.               AngleInc := round(v)
  4416.             else if pos('opacity', s) <> 0 then
  4417.               Opacity := round(v)
  4418.             else if pos('surface', s) <> 0 then
  4419.               DepthCueSurf := 100 - round(v)
  4420.             else if pos('interior', s) <> 0 then
  4421.               DepthCueInt := 100 - round(v)
  4422.             else
  4423.               MacroError('String not recognized:');
  4424.           end;
  4425.       end;
  4426.     GetRightParen;
  4427.         RoutinesCalled := RoutinesCalled + [SetProjectionC];
  4428.   end;
  4429.   
  4430.   
  4431.     procedure DoGetHistogram;
  4432.         var
  4433.             Left, Top, Width, Height: integer;
  4434.             SaveRoiRect: rect;
  4435.     begin
  4436.         GetLeftParen;
  4437.         left := GetInteger;
  4438.         GetComma;
  4439.         top := GetInteger;
  4440.         GetComma;
  4441.         width := GetInteger;
  4442.         if width < 1 then
  4443.             width := 1;
  4444.         GetComma;
  4445.         height := GetInteger;
  4446.         if height < 1 then
  4447.             height := 1;
  4448.         GetRightParen;
  4449.         if token <> DoneT then
  4450.             with Info^ do begin
  4451.                     SaveRoiRect := RoiRect;
  4452.                     SetRect(RoiRect, left, top, left + width, top + height);
  4453.                     GetRectHistogram;
  4454.                     RoiRect := SaveRoiRect;
  4455.                 end;
  4456.     end;
  4457.  
  4458.  
  4459.     procedure doFFTMacro; {(Options:string)}
  4460.         var
  4461.             options: str255;
  4462.     begin
  4463.         GetLeftParen;
  4464.         Options := GetString;
  4465.         GetRightParen;
  4466.         if (Token <> DoneT) then begin
  4467.                 MakeLowerCase(options);
  4468.                 if pos('foreward', options) <> 0 then
  4469.                     doFFT(ForewardFFT)
  4470.                 else if pos('inverse', options) <> 0 then begin
  4471.                     if pos('without', options) <> 0 then
  4472.                         doFFT(InverseFFT)
  4473.                     else if pos('filter', options) <> 0 then
  4474.                         doFFT(InverseFFTWithFilter)
  4475.                     else doFFT(InverseFFTWithMask)
  4476.                 end else if pos('display', options) <> 0 then
  4477.                     RedisplayPowerSpectrum
  4478.                 else if pos('swap', options) <> 0 then
  4479.                     doSwapQuadrants
  4480.                 else
  4481.                     MacroError('Unrecognized argument');
  4482.             end;
  4483.     end;
  4484.  
  4485.  
  4486.     procedure GetFileInfo; {(path: string, var type:string; var size: integer)}
  4487.     type
  4488.         CharArray = packed array[1..4] of char;
  4489.     var
  4490.         err: OSErr;
  4491.         path: str255;
  4492.         FinderInfo: FInfo;
  4493.         ftype: CharArray;
  4494.         loc1, loc2, f: integer;
  4495.         FileSize : LongInt;
  4496.     begin
  4497.         GetLeftParen;
  4498.         path := GetString;
  4499.         GetComma;
  4500.         loc1 := GetStringVar;
  4501.         GetComma;
  4502.         loc2 := GetVar;
  4503.         GetRightParen;
  4504.         if Token <> DoneT then with MacrosP^ do begin
  4505.             err := GetFInfo(path, 0, FinderInfo);
  4506.             if err = noErr then begin
  4507.                 err := fsopen(path, 0, f);
  4508.                 err := GetEOF(f, FileSize);
  4509.                 if err = noErr then
  4510.                     stack[loc2].value := FileSize
  4511.                 else
  4512.                     stack[loc2].value := -1;
  4513.                 err := fsclose(f);
  4514.                 fType := CharArray(FinderInfo.fdType);
  4515.                 stack[loc1].StringH^^ := concat(ftype[1], ftype[2], ftype[3], ftype[4]);
  4516.             end else begin
  4517.                 stack[loc1].StringH^^ := '';
  4518.                 stack[loc2].value := -1;
  4519.             end;
  4520.         end;
  4521.     end;
  4522.  
  4523.  
  4524.     procedure DoSelectTool;
  4525.     var
  4526.         tType: str255;
  4527.     begin
  4528.         GetLeftParen;
  4529.         tType := GetString;
  4530.         GetRightParen;
  4531.         if token = DoneT then
  4532.             exit(DoSelectTool);
  4533.         MakeLowerCase(tType);
  4534.         PreviousTool := CurrentTool;
  4535.             {left side tools}
  4536.         if pos('magn', tType) <> 0 then
  4537.             CurrentTool := MagnifyingGlass
  4538.         else if pos('grabber', tType) <> 0 then
  4539.             CurrentTool := Grabber
  4540.         else if pos('pencil', tType) <> 0 then
  4541.             CurrentTool := Pencil
  4542.         else if pos('eraser', tType) <> 0 then
  4543.             CurrentTool := Eraser
  4544.         else if pos('brush', tType) <> 0 then
  4545.             CurrentTool := Brush
  4546.         else if pos('drawline', tType) <> 0 then
  4547.             CurrentTool := ruler
  4548.         else if pos('paint', tType) <> 0 then
  4549.             CurrentTool := PaintBucket
  4550.         else if pos('profile', tType) <> 0 then
  4551.             CurrentTool := PlotTool
  4552.         else if pos('wand', tType) <> 0 then
  4553.             CurrentTool := Wand
  4554.         else if pos('angletool', tType) <> 0 then
  4555.             CurrentTool := AngleTool
  4556.             {right side tools}
  4557.         else if pos('rect', tType) <> 0 then
  4558.             CurrentTool := SelectionTool
  4559.         else if pos('oval', tType) <> 0 then
  4560.             CurrentTool := OvalSelectionTool
  4561.         else if pos('poly', tType) <> 0 then
  4562.             CurrentTool := PolygonTool
  4563.         else if pos('freehand', tType) <> 0 then
  4564.             CurrentTool := FreehandTool
  4565.         else if pos('straight', tType) <> 0 then begin
  4566.             CurrentTool := LineTool;
  4567.             LOIType := Straight;
  4568.         end
  4569.         else if pos('freeline', tType) <> 0 then begin
  4570.             CurrentTool := LineTool;
  4571.             LOIType := Freehand;
  4572.         end
  4573.         else if pos('segment', tType) <> 0 then begin
  4574.             CurrentTool := LineTool;
  4575.             LOIType := Segmented;
  4576.         end
  4577.         else if pos('lut', tType) <> 0 then
  4578.             CurrentTool := LUTTool
  4579.         else if pos('text', tType) <> 0 then
  4580.             CurrentTool := TextTool
  4581.         else if pos('spray', tType) <> 0 then
  4582.             CurrentTool := SprayCanTool
  4583.         else if pos('picker', tType) <> 0 then
  4584.             CurrentTool := PickerTool
  4585.         else if pos('cross', tType) <> 0 then
  4586.             CurrentTool := CrossHairTool
  4587.         else begin
  4588.             MacroError('Unrecognized tool name');
  4589.             exit(DoSelectTool);
  4590.         end;
  4591.         isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool)
  4592.             or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool);
  4593.         DrawTools;
  4594.         if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and
  4595.             (CurrentTool <> Grabber) and (CurrentTool <> Wand) then
  4596.                 KillRoi;
  4597.         with info^ do if RoiShowing then
  4598.             if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All}
  4599.                 KillRoi;
  4600.         if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin
  4601.             InfoMessage := '';
  4602.             if mCount > 0 then
  4603.                 ShowInfo;
  4604.         end;
  4605.         RoiMode := MoveMode;
  4606.         if CurrentTool = LineTool then
  4607.             if (LoiType = Straight) and (LineWidth <> 1) then begin
  4608.                 LineWidth := 1;
  4609.                 UpdateRoiLineWidth;
  4610.                 ShowLineWidth;
  4611.         end;
  4612.     end;
  4613.  
  4614.  
  4615.       procedure ExecuteCommand;
  4616.         var
  4617.             AutoSelectAll: boolean;
  4618.             t: FateTable;  {Needed for MakeSkeleton}
  4619.             okay: boolean;
  4620.             theEvent: EventRecord;
  4621.     begin
  4622.         if Info = NoInfo then
  4623.             if not (MacroCommand in LegalWithoutImage) then begin
  4624.                     MacroError('No image window active');
  4625.                     exit(ExecuteCommand);
  4626.                 end;
  4627.         if DoOption then begin
  4628.                 OptionKeyWasDown := true;
  4629.                 DoOption := false;
  4630.             end;
  4631.         if OpPending then
  4632.             if not (MacroCommand in [CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC, SetOptionC, PasteLiveC, GetRoiC, RequiresC, UndoC]) then begin
  4633.                     KillRoi; {Terminate any pending paste operation.}
  4634.                     RestoreRoi;
  4635.                 end;
  4636.         case MacroCommand of
  4637.             RotateRC, RotateLC: 
  4638.                 DoRotate(MacroCommand);
  4639.             FlipVC: 
  4640.                 FlipOrRotate(FlipVertical);
  4641.             FlipHC: 
  4642.                 FlipOrRotate(FlipHorizontal);
  4643.             CopyC:  begin
  4644.                     FindWhatToCopy;
  4645.                     if WhatToCopy = NothingToCopy then
  4646.                         MacroError('Copy failed')
  4647.                     else
  4648.                         DoCopy;
  4649.                 end;
  4650.             SelectC:
  4651.                 if CurrentWindow = TextKind then
  4652.                     SelectAllText
  4653.                 else begin
  4654.                     StopDigitizing;
  4655.                     SelectAll(true);
  4656.                 end;
  4657.             PasteC: 
  4658.                 DoPaste;
  4659.             ClearC, FillC, InvertC, FrameC: 
  4660.                 with info^ do begin
  4661.                         AutoSelectAll := not RoiShowing;
  4662.                         if AutoSelectAll then
  4663.                             SelectAll(true);
  4664.                         case MacroCommand of
  4665.                             ClearC: 
  4666.                                 DoOperation(EraseOp);
  4667.                             FillC: 
  4668.                                 DoOperation(PaintOp);
  4669.                             InvertC: 
  4670.                                 DoOperation(InvertOp);
  4671.                             FrameC: 
  4672.                                 DoOperation(FrameOp);
  4673.                         end;
  4674.                         UpdateScreen(RoiRect);
  4675.                         if AutoSelectAll then
  4676.                             KillRoi;
  4677.                     end;
  4678.             KillC: 
  4679.                 KillRoi;
  4680.             RestoreC: 
  4681.                 if NoInfo^.RoiType <> NoRoi then
  4682.                     RestoreRoi;
  4683.             AnalyzeC: 
  4684.                 DoAnalyzeParticles;
  4685.             ConvolveC: 
  4686.                 DoConvolve;
  4687.             NextC: 
  4688.                 GetNextWindow;
  4689.             MarkC: 
  4690.                 MarkSelection(mCount);
  4691.             MeasureC:  begin
  4692.                     Measure;
  4693.                     InitCursor;
  4694.                 end;
  4695.             MakeBinC: 
  4696.                 MakeBinary;
  4697.             DitherC: 
  4698.                 Filter(Dither, 0, t);
  4699.             SmoothC: 
  4700.                 if OptionKeyWasDown then
  4701.                     Filter(UnweightedAvg, 0, t)
  4702.                 else
  4703.                     Filter(WeightedAvg, 0, t);
  4704.             SharpenC: 
  4705.                 Filter(fsharpen, 0, t);
  4706.             ShadowC: 
  4707.                 DoShadow;
  4708.             TraceC: 
  4709.                 Filter(EdgeDetect, 0, t);
  4710.             ReduceC: 
  4711.                 Filter(ReduceNoise, 0, t);
  4712.             RedirectC: 
  4713.                 RedirectSampling := GetBooleanArg;
  4714.             ThresholdC: 
  4715.                 SetThreshold;
  4716.             AutoThresholdC: 
  4717.                 AutoThreshold;
  4718.             ResetgmC: 
  4719.                 ResetGrayMap;
  4720.             WaitC: 
  4721.                 DoWait;
  4722.             ResetmC: 
  4723.                 ResetCounter;
  4724.             SetSliceC: 
  4725.                 SetDensitySlice;
  4726.             UndoC: 
  4727.                 DoUndo;
  4728.             SetForeC, SetBackC: 
  4729.                 SetColor;
  4730.             HistoC:  begin
  4731.                     DoHistogram;
  4732.                     DrawHistogram;
  4733.                 end;
  4734.             EnhanceC: 
  4735.                 EnhanceContrast;
  4736.             EqualizeC: 
  4737.                 EqualizeHistogram;
  4738.             ErodeC:  begin
  4739.                     BinaryIterations := 1;
  4740.                     DoErosion;
  4741.                 end;
  4742.             DilateC:  begin
  4743.                     BinaryIterations := 1;
  4744.                     DoDilation;
  4745.                 end;
  4746.             OutlineC: 
  4747.                 filter(OutlineFilter, 0, t);
  4748.             ThinC: 
  4749.                 MakeSkeleton;
  4750.             AddConstC, MulConstC: 
  4751.                 DoConstantArithmetic;
  4752.             RevertC: 
  4753.                 DoRevert;
  4754.             BeepC: 
  4755.                 Beep;
  4756.             NopC: 
  4757.                 ;
  4758.             MakeC, MakeOvalC: 
  4759.                 MakeRoi;
  4760.             MoveC: 
  4761.                 MoveRoi;
  4762.             InsetC: 
  4763.                 InsetRoi;
  4764.             MoveToC: 
  4765.                 DoMoveTo;
  4766.             DrawTextC, WriteC, WritelnC, ShowMsgC: 
  4767.                 OutputText;
  4768.             SetFontC: 
  4769.                 SetFont;
  4770.             SetFontSizeC: 
  4771.                 SetFontSize;
  4772.             SetTextC: 
  4773.                 SetText;
  4774.             DrawNumC: 
  4775.                 DrawNumber;
  4776.             ExitC: 
  4777.                 token := DoneT;
  4778.             GetPicSizeC: 
  4779.                 GetPicSize;
  4780.             PutMsgC: 
  4781.                 DoPutMessage;
  4782.             GetRoiC: 
  4783.                 GetRoi;
  4784.             MakeNewC: 
  4785.                 DoMakeNewWindow;
  4786.             DrawScaleC: 
  4787.                 if info^.RoiShowing then begin
  4788.                         DrawScale;
  4789.                         UpdatePicWindow
  4790.                     end
  4791.                 else
  4792.                     MacroError('No Selection');
  4793.             SetPaletteC: 
  4794.                 DoSetPalette;
  4795.             OpenC, ImportC: 
  4796.                 DoOpenImage;
  4797.             SetImportC: 
  4798.                 SetImportAttributes;
  4799.             SetMinMaxC: 
  4800.                 SetImportMinMax;
  4801.             SetCustomC: 
  4802.                 SetCustomImport;
  4803.             SelectPicC, ChoosePicC: 
  4804.                 SelectPic;
  4805.             SetPicNameC: 
  4806.                 SetPicName;
  4807.             ApplyLutC: 
  4808.                 ApplyLookupTable;
  4809.             SetSizeC: 
  4810.                 SetNewSize;
  4811.             SaveC: 
  4812.                 DoSave;
  4813.             SaveAllC: 
  4814.                 SaveAll;
  4815.             SaveAsC: 
  4816.                 DoSaveAs;
  4817.             CopyResultsC: 
  4818.                 DoCopyResults;
  4819.             CloseC, DisposeC: 
  4820.                 CloseWindow;
  4821.             DisposeAllC: 
  4822.                 DisposeAll;
  4823.             DupC: 
  4824.                 DoDuplicate;
  4825.             GetInfoC: 
  4826.                 GetInfo;
  4827.             PrintC: 
  4828.                 DoPrint;
  4829.             LineToC: 
  4830.                 DoLineTo;
  4831.             GetLineC: 
  4832.                 DoGetLine;
  4833.             ShowPasteC: 
  4834.                 if PasteControl = nil then
  4835.                     ShowPasteControl
  4836.                 else
  4837.                     BringToFront(PasteControl);
  4838.             ChannelC: 
  4839.                 SetChannel;
  4840.             ColumnC, PlotProfileC:  begin
  4841.                     PlotDensityProfile;
  4842.                     if PlotWindow <> nil then
  4843.                         UpdatePlotWindow;
  4844.                 end;
  4845.             ScaleC, ScaleSelectionC: 
  4846.                 DoScaleAndRotate;
  4847.             SetOptionC: 
  4848.                 DoOption := true;
  4849.             SetLabelsC: 
  4850.                 DrawPlotLabels := GetBooleanArg;
  4851.             SetPlotScaleC: 
  4852.                 SetPlotScale;
  4853.             SetDimC: 
  4854.                 SetPlotDimensions;
  4855.             GetResultsC: 
  4856.                 GetResults;
  4857.             CopyModeC, AndC, OrC, XorC, BlendC, ReplaceC, AddC, SubC, MulC, DivC: 
  4858.                 DoPasteOperation;
  4859.             ScaleMathC: 
  4860.                 ScaleArithmetic := GetBooleanArg;
  4861.             InvertYC: 
  4862.                 InvertYCoordinates := GetBooleanArg;
  4863.             SetWidthC: 
  4864.                 SetWidth;
  4865.             ShowResultsC:  begin
  4866.                     ShowResults;
  4867.                     UpdateList
  4868.                 end;
  4869.             StartC: 
  4870.                 StartDigitizing;
  4871.             StopC: 
  4872.                 StopDigitizing;
  4873.             CaptureC: 
  4874.                 CaptureOneFrame;
  4875.             GetRowC, PutRowC, GetColumnC, PutColumnC: 
  4876.                 GetOrPutLineOrColumn;
  4877.             PlotXYZC: 
  4878.                 PlotXYZ;
  4879.             IncludeC: 
  4880.                 IncludeHoles := GetBooleanArg;
  4881.             AutoC: 
  4882.                 WandAutoMeasure := GetBooleanArg;
  4883.             LabelC: 
  4884.                 LabelParticles := GetBooleanArg;
  4885.             OutlineParticlesC: 
  4886.                 OutlineParticles := GetBooleanArg;
  4887.             IgnoreC: 
  4888.                 IgnoreParticlesTouchingEdge := GetBooleanArg;
  4889.             AdjustC: 
  4890.                 WandAdjustAreas := GetBooleanArg;
  4891.             SetParticleSizeC: 
  4892.                 SetParticleSize;
  4893.             SetPrecisionC: 
  4894.                 SetPrecision;
  4895.             PutPixelC: 
  4896.                 DoPutPixel;
  4897.             ScalingOptionsC: 
  4898.                 SetScaling;
  4899.             SetExportC: 
  4900.                 SetExportMode;
  4901.             ExportC: 
  4902.                 DoExport;
  4903.             ChangeC: 
  4904.                 DoChangeValues;
  4905.             UpdateResultsC:  begin
  4906.                     ShowInfo;
  4907.                     DeleteLines(mCount, mCount);
  4908.                     AppendResults;
  4909.                 end;
  4910.             TileC: 
  4911.                 TileImages;
  4912.             SetMajorC, SetMinorC, SetUser1C, SetUser2C: 
  4913.                 SetLabel;
  4914.             GetMouseC: 
  4915.                 DoGetMouse;
  4916.             SelectSliceC, ChooseSliceC, AddSliceC, DeleteSliceC, ResliceC:  begin
  4917.                     if info^.StackInfo = nil then
  4918.                         MacroError('No stack');
  4919.                     if token <> DoneT then
  4920.                         case MacroCommand of
  4921.                             SelectSliceC, ChooseSliceC: 
  4922.                                 DoSelectSlice;
  4923.                             AddSliceC: 
  4924.                                 okay := AddSlice(true);
  4925.                             DeleteSliceC: 
  4926.                                 DeleteSlice;
  4927.                             ResliceC: 
  4928.                                 Reslice;
  4929.                         end;
  4930.                 end;
  4931.             MakeStackC: 
  4932.                 MakeNewStack;
  4933.             AverageFramesC: 
  4934.                 DoAverageFrames;
  4935.             TriggerC: 
  4936.                 WaitForTrigger;
  4937.             MakeLineC: 
  4938.                 MakeLineRoi;
  4939.             GetTimeC: 
  4940.                 DoGetTime;
  4941.             SetScaleC: 
  4942.                 DoSetScale;
  4943.             SaveStateC: 
  4944.                 SaveState;
  4945.             RestoreStateC: 
  4946.                 RestoreState;
  4947.             SetCounterC: 
  4948.                 SetCounter;
  4949.             UpdateLutC: 
  4950.                 DoUpdateLUT;
  4951.             SetCountC: 
  4952.                 SetErosionDilationCount;
  4953.             PropagateLutC: 
  4954.                 DoPropagate(1);
  4955.             PropagateSpatialC: 
  4956.                 DoPropagate(2);
  4957.             PropagateDensityC: 
  4958.                 DoPropagate(3);
  4959.             SetSpacingC: 
  4960.                 SetSliceSpacing;
  4961.             RequiresC: 
  4962.                 CheckVersion;
  4963.             SetOptionsC: 
  4964.                 SetOptions;
  4965.             SubtractBackgroundC: 
  4966.                 SubtractBackground;
  4967.             MoveWindowC: 
  4968.                 MoveCurrentWindow;
  4969.             UserCodeC: 
  4970.                 DoUserCode;
  4971.             InvertLutC:  begin
  4972.                     InvertPalette;
  4973.                     UpdateLUT;
  4974.                 end;
  4975.             OpenSerialC: 
  4976.                 OpenSerial;
  4977.             PutSerialC: 
  4978.                 PutSerial;
  4979.             SetCursorC: 
  4980.                 DoSetCursor;
  4981.             SetVideoC: 
  4982.                 SetVideoOptions;
  4983.             AcquireC: 
  4984.                 DoAcquire;
  4985.             CallFilterC: 
  4986.                 CallFilterPlugin;
  4987.             PhotoModeC: 
  4988.                 DoPhotoMode;
  4989.             RGBToIndexedC: 
  4990.                 RGBToIndexed;
  4991.             SurfacePlotC: 
  4992.                 PlotSurface;
  4993.             SelectWindowC: 
  4994.                 DoSelectWindow;
  4995.             NewTextWindowC: 
  4996.                 DoNewTextWindow;
  4997.             CaptureColorC: 
  4998.                 CaptureColor;
  4999.             GetThresholdC: 
  5000.                 GetThreshold;
  5001.             AverageSlicesC: 
  5002.                 AverageSlices;
  5003.             SortPaletteC: 
  5004.                 SortPalette;
  5005.             ProjectC: 
  5006.                 DoProject;
  5007.             ScaleConvolutionsC: 
  5008.                 ScaleConvolutions := GetBooleanArg;
  5009.             ImageMathC: 
  5010.                 ImageMath;
  5011.             PasteLiveC: 
  5012.                 PasteLive;
  5013.             GetPlotDataC: 
  5014.                 GetPlotData;
  5015.             DeleteC: 
  5016.                 DoDelete;
  5017.             GetScaleC: 
  5018.                 GetScale;
  5019.             AutoOutlineC: 
  5020.                 DoAutoOutline;
  5021.             FilterC: 
  5022.                 DoFilter;
  5023.             SetSaveAsC:
  5024.                 SetSaveAsMode;
  5025.             CalibrateC:
  5026.                 DoCalibrate;
  5027.             CallExportC:
  5028.                 CallExportPlugin;
  5029.             IndexedToRGBC:
  5030.                 ConvertEightBitColorToRGB;
  5031.             MakeMovieC:
  5032.                 DoMakeMovie;
  5033.        SetProjectionC:
  5034.           SetProjection;
  5035.        GetHistogramC:
  5036.               DoGetHistogram;
  5037.           fftC:
  5038.               doFFTMacro;
  5039.           GetFileInfoC:
  5040.               GetFileInfo;
  5041.           SelectToolC:
  5042.               DoSelectTool;
  5043.         end; {case}
  5044.         OptionKeyWasDown := false;
  5045.         if not macro then begin
  5046.                 Token := DoneT;
  5047.                 KillRoi;
  5048.             end;
  5049.         if TickCount > MacroTicks then begin
  5050.                 if EventAvail(everyEvent, theEvent) then; {Allows background tasks to run}
  5051.                 if CommandPeriod then begin
  5052.                         Token := DoneT;
  5053.                         KillRoi;
  5054.                     end;
  5055.                 MacroTicks := TickCount + 15;
  5056.             end;
  5057.     end;
  5058.  
  5059.  
  5060.     procedure DoCompoundStatement;
  5061.     begin
  5062.         if token <> BeginT then
  5063.             MacroError('"begin" expected');
  5064.         GetToken;
  5065.         while (token <> endT) and (token <> DoneT) do begin
  5066.                 DoStatement;
  5067.                 GetToken;
  5068.                 if Token = SemiColon then
  5069.                     GetToken
  5070.                 else if token <> EndT then
  5071.                     MacroError(EndExpected);
  5072.             end;
  5073.     end;
  5074.  
  5075.  
  5076.     procedure SkipCompoundStatement;
  5077.         var
  5078.             count: integer;
  5079.     begin
  5080.         count := 1;
  5081.         repeat
  5082.             GetToken;
  5083.             case token of
  5084.                 beginT: 
  5085.                     count := count + 1;
  5086.                 endT: 
  5087.                     count := count - 1;
  5088.                 DoneT:  begin
  5089.                         MacroError('"end" expected');
  5090.                         exit(SkipCompoundStatement);
  5091.                     end;
  5092.                 otherwise
  5093.             end; {case}
  5094.         until count = 0;
  5095.     end;
  5096.  
  5097.  
  5098.     procedure DoDeclarations;
  5099.     begin
  5100.         if token = SemiColon then
  5101.             GetToken;
  5102.         if token = VarT then begin
  5103.                 GetToken;
  5104.                 while ((token = Identifier) or (token = variable) or (token = StringVariable)) and (Token <> DoneT) do
  5105.                     DoDeclaration;
  5106.             end;
  5107.     end;
  5108.  
  5109.  
  5110.     procedure DoFor;
  5111.         var
  5112.             SavePC, StackLoc: integer;
  5113.             StartValue, EndValue, i: LongInt;
  5114.     begin
  5115.         StackLoc := GetVar;
  5116.         GetToken;
  5117.         if token <> AssignOp then begin
  5118.                 MacroError('":=" expected');
  5119.                 exit(DoFor);
  5120.             end;
  5121.         StartValue := GetInteger;
  5122.         if token = DoneT then
  5123.             exit(DoFor);
  5124.         GetToken;
  5125.         if token <> ToT then begin
  5126.                 MacroError('"to" expected');
  5127.                 exit(DoFor);
  5128.             end;
  5129.         EndValue := GetInteger;
  5130.         if token = DoneT then
  5131.             exit(DoFor);
  5132.         GetToken;
  5133.         if token <> DoT then begin
  5134.                 MacroError(DoExpected);
  5135.                 exit(DoFor);
  5136.             end;
  5137.         SavePC := pc;
  5138.         if StartValue > EndValue then begin
  5139.                 GetToken;
  5140.                 SkipStatement
  5141.             end
  5142.         else
  5143.             for i := StartValue to EndValue do
  5144.                 with MacrosP^ do begin
  5145.                         Stack[StackLoc].value := i;
  5146.                         pc := SavePC;
  5147.                         GetToken;
  5148.                         DoStatement;
  5149.                         LoopCounter := LoopCounter + 1;
  5150.                         if LoopCounter >= MaxLoopCount then begin
  5151.                             if CommandPeriod then
  5152.                                 token := DoneT;
  5153.                             LoopCounter := 0;
  5154.                         end;
  5155.                         if Token = DoneT then
  5156.                             leave;
  5157.                         if Digitizing then
  5158.                             DoCapture;
  5159.                     end;
  5160.     end;
  5161.  
  5162.  
  5163.     procedure SkipFor;
  5164.     begin
  5165.         GetToken;
  5166.         SkipPartialStatement;
  5167.         GetToken;
  5168.         if token <> doT then
  5169.             MacroError(DoExpected);
  5170.         GetToken;
  5171.         SkipStatement
  5172.     end;
  5173.  
  5174.  
  5175.     procedure DoAssignment;
  5176.         var
  5177.             SaveStackLoc: integer;
  5178.     begin
  5179.         SaveStackLoc := TokenStackLoc;
  5180.         GetToken;
  5181.         if token <> AssignOp then begin
  5182.                 MacroError('":=" expected');
  5183.                 exit(DoAssignment);
  5184.             end;
  5185.         MacrosP^.stack[SaveStackLoc].value := GetBooleanExpression;
  5186.     end;
  5187.  
  5188.  
  5189.     procedure DoStringAssignment;
  5190.         var
  5191.             SaveStackLoc: integer;
  5192.             str: Str255;
  5193.     begin
  5194.         SaveStackLoc := TokenStackLoc;
  5195.         GetToken;
  5196.         if token <> AssignOp then begin
  5197.                 MacroError('":=" expected');
  5198.                 exit(DoStringAssignment);
  5199.             end;
  5200.         str := GetString;
  5201.         if token <> DoneT then
  5202.             with MacrosP^.stack[SaveStackLoc] do
  5203.                 if StringH <> nil then
  5204.                     StringH^^ := str;
  5205.     end;
  5206.  
  5207.  
  5208.     procedure SkipPartialStatement;
  5209.         var
  5210.             done: Boolean;
  5211.     begin
  5212.         done := token = DoneT;
  5213.         while not done do begin
  5214.                 case token of
  5215.                     ThenT, DoT, SemiColon, EndT, ElseT, UntilT:  begin
  5216.                             PutTokenBack;
  5217.                             done := true;
  5218.                         end;
  5219.                     DoneT, BeginT, ForT, IfT, WhileT, RepeatT:  begin
  5220.                             MacroError('end of statement expected');
  5221.                             done := true;
  5222.                         end;
  5223.                     otherwise
  5224.                         GetToken;
  5225.                 end;
  5226.             end;
  5227.     end;
  5228.  
  5229.  
  5230.     procedure DoIf;
  5231.         var
  5232.             isTrue: boolean;
  5233.     begin
  5234.         isTrue := GetBoolean;
  5235.         GetToken;
  5236.         if token <> ThenT then
  5237.             MacroError(ThenExpected);
  5238.         if isTrue then begin
  5239.                 GetToken;
  5240.                 DoStatement
  5241.             end
  5242.         else begin
  5243.                 GetToken;
  5244.                 SkipStatement;
  5245.             end;
  5246.         GetToken;
  5247.         if token = elseT then begin
  5248.                 if isTrue then begin
  5249.                         GetToken;
  5250.                         SkipStatement
  5251.                     end
  5252.                 else begin
  5253.                         GetToken;
  5254.                         DoStatement;
  5255.                     end;
  5256.             end
  5257.         else
  5258.             PutTokenBack;
  5259.     end;
  5260.  
  5261.  
  5262.     procedure SkipIf;
  5263.     begin
  5264.         GetToken;
  5265.         SkipPartialStatement;
  5266.         GetToken;
  5267.         if token <> thenT then
  5268.             MacroError(ThenExpected);
  5269.         GetToken;
  5270.         SkipStatement;
  5271.         GetToken;
  5272.         if token <> elseT then
  5273.             PutTokenBack
  5274.         else begin
  5275.                 GetToken;
  5276.                 SkipStatement
  5277.             end
  5278.     end;
  5279.  
  5280.  
  5281.     procedure DoWhile;
  5282.         var
  5283.             isTrue: boolean;
  5284.             SavePC: integer;
  5285.     begin
  5286.         SavePC := pc;
  5287.         repeat
  5288.             pc := SavePC;
  5289.             isTrue := GetBoolean;
  5290.             GetToken;
  5291.             if token <> doT then
  5292.                 MacroError(DoExpected);
  5293.             if isTrue then begin
  5294.                     GetToken;
  5295.                     DoStatement
  5296.                 end
  5297.             else begin
  5298.                     GetToken;
  5299.                     SkipStatement;
  5300.                 end;
  5301.             if Digitizing then
  5302.                 DoCapture;
  5303.             LoopCounter := LoopCounter + 1;
  5304.             if LoopCounter >= MaxLoopCount then begin
  5305.                 if CommandPeriod then
  5306.                     token := DoneT;
  5307.                 LoopCounter := 0;
  5308.             end;
  5309.         until not isTrue or (Token = DoneT);
  5310.     end;
  5311.  
  5312.  
  5313.     procedure SkipWhile;
  5314.     begin
  5315.         GetToken;
  5316.         SkipPartialStatement;
  5317.         GetToken;
  5318.         if token <> doT then
  5319.             MacroError(DoExpected);
  5320.         GetToken;
  5321.         SkipStatement
  5322.     end;
  5323.  
  5324.  
  5325.     procedure DoRepeat;
  5326.         var
  5327.             isTrue: boolean;
  5328.             SavePC: integer;
  5329.     begin
  5330.         SavePC := pc;
  5331.         isTrue := true;
  5332.         repeat
  5333.             pc := SavePC;
  5334.             GetToken;
  5335.             while (token <> untilT) and (token <> DoneT) do begin
  5336.                     DoStatement;
  5337.                     GetToken;
  5338.                     if Token = SemiColon then
  5339.                         GetToken;
  5340.                     LoopCounter := LoopCounter + 1;
  5341.                     if LoopCounter >= MaxLoopCount then begin
  5342.                         if CommandPeriod then
  5343.                             token := DoneT;
  5344.                         LoopCounter := 0;
  5345.                     end;
  5346.                 end;
  5347.             if token <> untilT then
  5348.                 MacroError(UntilExpected);
  5349.             isTrue := GetBoolean;
  5350.             if Digitizing then
  5351.                 DoCapture;
  5352.         until isTrue or (Token = DoneT);
  5353.     end;
  5354.  
  5355.  
  5356.     procedure SkipRepeat;
  5357.     begin
  5358.         GetToken;
  5359.         while (token <> untilT) and (token <> DoneT) do begin
  5360.                 SkipStatement;
  5361.                 GetToken;
  5362.                 if token = SemiColon then
  5363.                     GetToken
  5364.                 else if token <> UntilT then
  5365.                     MacroError(UntilExpected);
  5366.             end;
  5367.         GetToken;
  5368.         SkipPartialStatement;
  5369.     end;
  5370.  
  5371.  
  5372.     procedure DoArrayAssignment;
  5373.         var
  5374.             SaveArrayType: ArrayType;
  5375.             index, LutValue, PixelValue, RegisterValue: LongInt;
  5376.             SyncChannel: integer;
  5377.     begin
  5378.         SaveArrayType := ArrayType(MacroCommand);
  5379.         GetToken;
  5380.         if token <> LeftBracket then
  5381.             MacroError('"[" expected');
  5382.         Index := GetInteger;
  5383.         GetToken;
  5384.         if token <> RightBracket then
  5385.             MacroError('"]" expected');
  5386.         GetToken;
  5387.         if token <> AssignOp then
  5388.             MacroError('":=" expected');
  5389.  
  5390.         if SaveArrayType = BufferA then begin
  5391.                 CheckIndex(index, 0, MaxLine - 1);
  5392.                 PixelValue := GetInteger;
  5393.                 RangeCheck(PixelValue);
  5394.                 if token <> DoneT then
  5395.                     MacrosP^.aLine[index] := PixelValue;
  5396.                 exit(DoArrayAssignment);
  5397.             end;
  5398.  
  5399.         if SaveArrayType in [RedLutA, BlueLutA, GreenLutA] then begin
  5400.                 RangeCheck(index);
  5401.                 LutValue := GetInteger;
  5402.                 RangeCheck(LutValue);
  5403.                 if token <> DoneT then
  5404.                     with info^.cTable[index].rgb do
  5405.                         case SaveArrayType of
  5406.                             RedLutA: 
  5407.                                 red := bsl(LutValue, 8);
  5408.                             GreenLutA: 
  5409.                                 green := bsl(LutValue, 8);
  5410.                             BlueLutA: 
  5411.                                 blue := bsl(LutValue, 8);
  5412.                         end;
  5413.                 exit(DoArrayAssignment);
  5414.             end;
  5415.  
  5416.         if SaveArrayType = ScionA then begin
  5417.                 if framegrabber <> ScionLG3 then
  5418.                     MacroError('No Scion LG-3');
  5419.                 if Token <> DoneT then
  5420.                     CheckIndex(index, 1, 4);
  5421.                 if Token = DoneT then
  5422.                     exit(DoArrayAssignment);
  5423.                 if index = 3 then
  5424.                     MacroError('DataIn is read-only');
  5425.                 RegisterValue := GetInteger;
  5426.                 if token <> DoneT then begin
  5427.                         if RegisterValue < 0 then
  5428.                             RegisterValue := 0;
  5429.                         if RegisterValue > 255 then
  5430.                             RegisterValue := 255;
  5431.                         case index of
  5432.                             1:  begin
  5433.                                     LG3DacA := RegisterValue;
  5434.                                     DacAReg^ := LG3DacA
  5435.                                 end;
  5436.                             2:  begin
  5437.                                     LG3DacB := RegisterValue;
  5438.                                     DacBReg^ := LG3DacB
  5439.                                 end;
  5440.                             4:  begin
  5441.                                     LG3DataOut := band(RegisterValue, $f);
  5442.                                     if SyncMode = SeparateSync then
  5443.                                         SyncChannel := 3
  5444.                                     else
  5445.                                         SyncChannel := VideoChannel;
  5446.                                     ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  5447.                                 end;
  5448.                         end; {case}
  5449.                     end;
  5450.                 exit(DoArrayAssignment);
  5451.             end;
  5452.  
  5453.         if SaveArrayType = PlotDataA then begin
  5454.                 CheckIndex(index, 0, MaxLine - 1);
  5455.                 PlotData^[index] := GetExpression;
  5456.                 exit(DoArrayAssignment);
  5457.             end;
  5458.  
  5459.         CheckIndex(index, 1, MaxMeasurements);
  5460.         if token <> DoneT then
  5461.             case SaveArrayType of
  5462.                 rAreaA: 
  5463.                     mArea^[Index] := GetExpression;
  5464.                 rMeanA: 
  5465.                     mean^[Index] := GetExpression;
  5466.                 rStdDevA: 
  5467.                     sd^[Index] := GetExpression;
  5468.                 rXA: 
  5469.                     xcenter^[Index] := GetExpression;
  5470.                 rYA: 
  5471.                     ycenter^[Index] := GetExpression;
  5472.                 rLengthA: 
  5473.                     plength^[Index] := GetExpression;
  5474.                 rMinA: 
  5475.                     mMin^[Index] := GetExpression;
  5476.                 rMaxA: 
  5477.                     mMax^[Index] := GetExpression;
  5478.                 rMajorA: 
  5479.                     MajorAxis^[Index] := GetExpression;
  5480.                 rMinorA: 
  5481.                     MinorAxis^[Index] := GetExpression;
  5482.                 rAngleA: 
  5483.                     orientation^[Index] := GetExpression;
  5484.                 rUser1A: 
  5485.                     User1^[Index] := GetExpression;
  5486.                 rUser2A: 
  5487.                     User2^[Index] := GetExpression;
  5488.                 otherwise
  5489.                     MacroError('Read-only array');
  5490.             end; {case}
  5491.     end;
  5492.  
  5493.  
  5494.     procedure PushArguments (var nArgs: integer);
  5495.         var
  5496.             arg: array[1..MaxArgs] of extended;
  5497.             StringArg: array[1..MaxArgs] of boolean;
  5498.             i, nStringArgs: integer;
  5499.             TempName: SymbolType;
  5500.     begin
  5501.         nArgs := 0;
  5502.         nStringArgs := 0;
  5503.         GetToken;
  5504.         while token in [Variable, StringVariable, StringLiteral, NumericLiteral, TrueT, FalseT, FunctionT, StringFunctionT, ArrayT, comma, MinusOp, LeftParen] do begin
  5505.                 if token = comma then
  5506.                     GetToken;
  5507.                 if nArgs < MaxArgs then
  5508.                     nArgs := nArgs + 1
  5509.                 else
  5510.                     MacroError('Too many arguments');
  5511.                 if (token = StringVariable) or (token = StringLiteral) or (token = StringFunctionT) then begin
  5512.                         nStringArgs := nStringArgs + 1;
  5513.                         arg[nArgs] := 0.0;
  5514.                         StringArg[nArgs] := true;
  5515.                         if token = StringFunctionT then
  5516.                             TokenStr := DoStringFunction;
  5517.                     end
  5518.                 else begin
  5519.                         PutTokenBack;
  5520.                         arg[nArgs] := GetBooleanExpression;
  5521.                         StringArg[nArgs] := false;
  5522.                     end;
  5523.                 if nStringArgs > 1 then
  5524.                     MacroError('No more than one string argument allowed');
  5525.                 GetToken;
  5526.             end;
  5527.         if token <> RightParen then
  5528.             MacroError(RightParenExpected);
  5529.         for i := 1 to nArgs do begin
  5530.                 if TopOfStack < MaxMacroStackSize then
  5531.                     TopOfStack := TopOfStack + 1
  5532.                 else
  5533.                     MacroError(StackOverflow);
  5534.                 with MacrosP^.stack[TopOfStack] do begin
  5535.                         value := arg[i];
  5536.                         StringH := nil;
  5537.                         if StringArg[i] then begin
  5538.                                 vType := StringVar;
  5539.                                 StringsAllocated := true;
  5540.                                 StringH := str255H(NewHandle(SizeOf(str255)));
  5541.                                 if StringH = nil then begin
  5542.                                         MacroError('Out of memory');
  5543.                                         Token := DoneT
  5544.                                     end
  5545.                                 else
  5546.                                     StringH^^ := TokenStr;
  5547.                             end
  5548.                         else
  5549.                             vType := RealVar;
  5550.                         value := arg[i];
  5551.                     end;
  5552.             end;
  5553.     end;
  5554.  
  5555.  
  5556.     procedure PushFunctionResult(SymbolLoc: integer; var ReturnValueLoc: integer);
  5557.         var
  5558.             StackLoc: integer;
  5559.     begin
  5560.         if TopOfStack >= MaxMacroStackSize then begin
  5561.                 MacroError(StackOverflow);
  5562.                 exit(PushFunctionResult);
  5563.             end;
  5564.         TopOfStack := TopOfStack + 1;
  5565.         ReturnValueLoc := TopOfStack;
  5566.         with MacrosP^.stack[TopOfStack] do begin
  5567.                 SymbolTableIndex := SymbolLoc;
  5568.                 value := 0.0;
  5569.                 StringH := nil;
  5570.             end;
  5571.         with macrosP^.stack[TopOfStack] do
  5572.             case token of
  5573.                 IntegerT: 
  5574.                     vType := IntVar;
  5575.                 RealT: 
  5576.                     vType := RealVar;
  5577.                 BooleanT: 
  5578.                     vType := BooleanVar;
  5579.                 StringT:  begin
  5580.                         vType := StringVar;
  5581.                         StringH := str255H(NewHandle(SizeOf(str255)));
  5582.                         StringsAllocated := true;
  5583.                         if StringH = nil then begin
  5584.                                 MacroError('Out of memory');
  5585.                                 Token := DoneT
  5586.                             end
  5587.                         else
  5588.                             StringH^^ := '';
  5589.                     end;
  5590.                 otherwise
  5591.             end;
  5592.     end;
  5593.  
  5594.  
  5595.     procedure DoUserFunction;
  5596.         var
  5597.             SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
  5598.             SaveSymbolTableLoc, ReturnValueLoc: integer;
  5599.             SaveName, NewFuncName: SymbolType;
  5600.             SaveStringsAllocated: boolean;
  5601.     begin
  5602.         NewPCStart := TokenLoc;
  5603.         NewFuncName := TokenSymbol;
  5604.         SaveStackLoc := TopOfStack;
  5605.         SaveSymbolTableLoc := SymbolTableLoc;
  5606.         SaveStringsAllocated := StringsAllocated;
  5607.         StringsAllocated := false;
  5608.         GetToken;
  5609.         if token = LeftParen then
  5610.             PushArguments(nArgs)
  5611.         else begin
  5612.                 nArgs := 0;
  5613.                 PutTokenBack;
  5614.             end;
  5615.         SavePCStart := PCStart;
  5616.         PCStart := NewPCStart;
  5617.         LineStartPC := NewPCStart - 1;
  5618.         SaveName := MacroOrProcName;
  5619.         MacroOrProcName := NewFuncName;
  5620.         SavePC := pc;
  5621.         pc := pcStart;
  5622.         if nArgs > 0 then begin
  5623.                 GetLeftParen;
  5624.                 i := 0;
  5625.                 GetToken;
  5626.                 while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
  5627.                         if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
  5628.                                 if i < nArgs then
  5629.                                     i := i + 1
  5630.                                 else
  5631.                                     MacroError('Too many formal arguments');
  5632.                                 MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
  5633.                             end;
  5634.                         GetToken;
  5635.                     end;
  5636.                 if Token = VarT then
  5637.                     MacroError('VAR parameters not supported');
  5638.                 if i < nArgs then
  5639.                     MacroError('Too few formal arguments');
  5640.                 if token <> RightParen then
  5641.                     MacroError(RightParenExpected);
  5642.             end;
  5643.         GetToken;
  5644.         if token <> colon then
  5645.             MacroError('":" expected');
  5646.         GetToken;
  5647.         if (token <> IntegerT) and (token <> RealT) and (token <> BooleanT) and (token <> StringT) then
  5648.             MacroError('"integer", "real", "boolean" or "string" expected');
  5649.         PushFunctionResult(SaveSymbolTableLoc, ReturnValueLoc);
  5650.         GetToken;
  5651.         if (token = LeftParen) and (nArgs = 0) then
  5652.             MacroError('Arguments not expected');
  5653.         DoDeclarations;
  5654.         DoCompoundStatement;
  5655.         pc := SavePC;
  5656.         with MacrosP^.stack[ReturnValueLoc] do begin
  5657.       {Get return value from stack}
  5658.             if (vType = StringVar) and (StringH <> nil) then begin
  5659.                 TokenStr := StringH^^;
  5660.                 TokenValue := 0.0;
  5661.             end else begin
  5662.                 TokenValue := value;
  5663.                 TokenStr := 'No return string';
  5664.             end;
  5665.         end;
  5666.         if StringsAllocated then
  5667.             DeallocateStrings(SaveStackLoc + 1, TopOfStack);
  5668.         StringsAllocated := SaveStringsAllocated;
  5669.         TopOfStack := SaveStackLoc;
  5670.         pcStart := SavePCStart;
  5671.         MacroOrProcName := SaveName;
  5672.     end; {DoUserFunction}
  5673.  
  5674.  
  5675.     procedure DoProcedure;
  5676.         var
  5677.             SavePC, SavePCStart, NewPCStart, SaveStackLoc, nArgs, i: integer;
  5678.             SaveProcName, NewProcName: SymbolType;
  5679.             SaveStringsAllocated: boolean;
  5680.     begin
  5681.         NewPCStart := TokenLoc;
  5682.         NewProcName := TokenSymbol;
  5683.         SaveStackLoc := TopOfStack;
  5684.         SaveStringsAllocated := StringsAllocated;
  5685.         StringsAllocated := false;
  5686.         GetToken;
  5687.         if token = LeftParen then
  5688.             PushArguments(nArgs)
  5689.         else begin
  5690.                 nArgs := 0;
  5691.                 PutTokenBack;
  5692.             end;
  5693.         SavePCStart := PCStart;
  5694.         PCStart := NewPCStart;
  5695.         LineStartPC := NewPCStart - 1;
  5696.         SaveProcName := MacroOrProcName;
  5697.         MacroOrProcName := NewProcName;
  5698.         SavePC := pc;
  5699.         pc := pcStart;
  5700.         if nArgs > 0 then begin
  5701.                 GetLeftParen;
  5702.                 i := 0;
  5703.                 GetToken;
  5704.                 while token in [Identifier, Variable, StringVariable, comma, colon, SemiColon, RealT, IntegerT, BooleanT, StringT] do begin
  5705.                         if (token = Identifier) or (token = Variable) or (token = StringVariable) then begin
  5706.                                 if i < nArgs then
  5707.                                     i := i + 1
  5708.                                 else
  5709.                                     MacroError('Too many formal arguments');
  5710.                                 MacrosP^.stack[SaveStackLoc + i].SymbolTableIndex := SymbolTableloc;
  5711.                             end;
  5712.                         GetToken;
  5713.                     end;
  5714.                 if Token = VarT then
  5715.                     MacroError('VAR parameters not supported');
  5716.                 if i < nArgs then
  5717.                     MacroError('Too few formal arguments');
  5718.                 if token <> RightParen then
  5719.                     MacroError(RightParenExpected);
  5720.             end;
  5721.         GetToken;
  5722.         if (token = LeftParen) and (nArgs = 0) then
  5723.             MacroError('Arguments not expected');
  5724.         DoDeclarations;
  5725.         DoCompoundStatement;
  5726.         pc := SavePC;
  5727.         if StringsAllocated then
  5728.             DeallocateStrings(SaveStackLoc + 1, TopOfStack);
  5729.         StringsAllocated := SaveStringsAllocated;
  5730.         TopOfStack := SaveStackLoc;
  5731.         pcStart := SavePCStart;
  5732.         MacroOrProcName := SaveProcName;
  5733.     end;
  5734.  
  5735.  
  5736.     procedure CannotBeginWithThis;
  5737.         var
  5738.             str: str255;
  5739.     begin
  5740.         str := '';
  5741.         ConvertTokenToString(str);
  5742.         MacroError(concat('Statement cannot begin with ', '"', str, '"'));
  5743.     end;
  5744.     
  5745.     
  5746.     procedure DoFunctionAssignment;
  5747.         var
  5748.             SaveStackLoc: integer;
  5749.             value: extended;
  5750.     begin
  5751.         LookupVariable;
  5752.         SaveStackLoc := TokenStackLoc;
  5753.         GetToken;
  5754.         if token <> AssignOp then begin
  5755.                 MacroError('":=" expected');
  5756.                 exit(DoFunctionAssignment);
  5757.             end;
  5758.         with MacrosP^.stack[SaveStackLoc] do begin
  5759.             if (vType =StringVar) and (StringH <> nil) then
  5760.                 StringH^^ := GetString
  5761.             else
  5762.                 value := GetBooleanExpression;
  5763.         end;
  5764.     end;
  5765.  
  5766.  
  5767.     procedure DoStatement;
  5768.     begin
  5769.         case token of
  5770.             BeginT: 
  5771.                 DoCompoundStatement;
  5772.             CommandT: 
  5773.                 ExecuteCommand;
  5774.             ForT: 
  5775.                 DoFor;
  5776.             IfT: 
  5777.                 DoIf;
  5778.             WhileT: 
  5779.                 DoWhile;
  5780.             RepeatT: 
  5781.                 DoRepeat;
  5782.             Identifier: 
  5783.                 MacroError('Undefined identifier');
  5784.             Variable: 
  5785.                 DoAssignment;
  5786.             StringVariable: 
  5787.                 DoStringAssignment;
  5788.             ArrayT: 
  5789.                 DoArrayAssignment;
  5790.             ProcedureT: 
  5791.                 DoProcedure;
  5792.             ElseT: 
  5793.                 MacroError('Statement expected');
  5794.             FunctionT, StringFunctionT: 
  5795.                 MacroError('Variable expected');
  5796.             UserFunctionT:
  5797.                 DoFunctionAssignment;
  5798.             SemiColon: 
  5799.                 PutTokenBack; {Null statement}
  5800.             otherwise
  5801.                 CannotBeginWithThis
  5802.         end;
  5803.     end;
  5804.  
  5805.  
  5806.     procedure SkipStatement;
  5807.     begin
  5808.         case token of
  5809.             BeginT: 
  5810.                 SkipCompoundStatement;
  5811.             ForT: 
  5812.                 SkipFor;
  5813.             IfT: 
  5814.                 SkipIf;
  5815.             WhileT: 
  5816.                 SkipWhile;
  5817.             RepeatT: 
  5818.                 SkipRepeat;
  5819.             CommandT, Variable, StringVariable, ArrayT, ProcedureT, UserFunctionT: 
  5820.                 SkipPartialStatement;
  5821.             DoneT: 
  5822.                 ; {Aborting the macro}
  5823.             SemiColon, EndT, ElseT, UntilT: 
  5824.                 PutTokenBack; {These tokens can follow a statement}
  5825.             otherwise
  5826.                 CannotBeginWithThis
  5827.         end;
  5828.     end;
  5829.  
  5830.  
  5831.  
  5832.     procedure RunMacro (nMacro: integer);
  5833.         var
  5834.             count: integer;
  5835.             str: str255;
  5836.             SaveInfo: InfoPtr;
  5837.     begin
  5838.         DefaultFileName := '';
  5839.         str := '';
  5840.         nSaves := 0;
  5841.         DefaultRefNum := 0;
  5842.         count := 0;
  5843.         pcStart := MacroStart[nMacro];
  5844.         pc := pcStart;
  5845.         SavePC := pcStart;
  5846.         LineStartPC := pcStart;
  5847.         token := NullT;
  5848.         macro := true;
  5849.         DoOption := false;
  5850.         SaveInfo := info;
  5851.         TopOfStack := nGlobals;
  5852.         MacroOrProcName := BlankSymbol;
  5853.         StringsAllocated := false;
  5854.         InPhotoMode := false;
  5855.         RoutinesCalled := [];
  5856.         MacroTicks := TickCount + 15;
  5857.         LoopCounter := 0;
  5858.         GetToken;
  5859.         DoDeclarations;
  5860.         DoCompoundStatement;
  5861.         if (info <> SaveInfo) and (info <> NoInfo) then
  5862.             SelectWindow(info^.wptr);
  5863.         with info^, RoiRect do begin
  5864.                 if ((right - left) <= 0) or ((bottom - top) <= 0) then
  5865.                     KillRoi;
  5866.             end;
  5867.         if info^.RoiShowing then
  5868.             if not (OpPending and (CurrentOp = PasteOp)) then begin
  5869.               KIllRoi;
  5870.               RestoreRoi;
  5871.             end;
  5872.         macro := false;
  5873.         if StringsAllocated then
  5874.             DeallocateStrings(nGlobals + 1, TopOfStack);
  5875.         if InPhotoMode then
  5876.             RestoreScreen;
  5877.     end;
  5878.  
  5879.  
  5880.     procedure RunKeyMacro (ch: char; KeyCode: integer);
  5881.         const
  5882.             FunctionKey = 16;
  5883.         var
  5884.             i: integer;
  5885.     begin
  5886.         if (ord(ch) = 0) then
  5887.             exit(RunKeyMacro);
  5888.         if (ch >= 'A') and (ch <= 'Z') then
  5889.             ch := chr(ord(ch) + 32); {Convert to lower case}
  5890.         if ord(ch) = FunctionKey then
  5891.             case KeyCode of
  5892.                 122: 
  5893.                     ch := 'A';
  5894.                 120: 
  5895.                     ch := 'B';
  5896.                 99: 
  5897.                     ch := 'C';
  5898.                 118: 
  5899.                     ch := 'D';
  5900.                 96: 
  5901.                     ch := 'E';
  5902.                 97: 
  5903.                     ch := 'F';
  5904.                 98: 
  5905.                     ch := 'G';
  5906.                 100: 
  5907.                     ch := 'H';
  5908.                 101: 
  5909.                     ch := 'I';
  5910.                 109: 
  5911.                     ch := 'J';
  5912.                 103: 
  5913.                     ch := 'K';
  5914.                 111: 
  5915.                     ch := 'L';
  5916.                 105: 
  5917.                     ch := 'M';
  5918.                 107: 
  5919.                     ch := 'N';
  5920.                 113: 
  5921.                     ch := 'O';
  5922.                 otherwise
  5923.             end;
  5924.         for i := 1 to nMacros do
  5925.             if ch = MacroKey[i] then begin
  5926.                     RunMacro(i);
  5927.                     leave;
  5928.                 end;
  5929.     end;
  5930.  
  5931.  
  5932.  
  5933. end.